Declaring API functions in 64 bit Office
Content
- Introduction
- Links
- Declarations by API function
- Which Longs should become LongPtr?
- Conditional compiling
- Other API functions
Introduction
If you develop VBA code for multiple versions of Office, you may face a challenge: ensuring your code works on both 32 bit and 64 bit platforms.
This page is meant to be the first stop for anyone who needs the proper syntax for his API declaration statement in Office VBA.
Many of the declarations were figured out by Charles Williams of www.decisionmodels.com when he created the 64 bit version of our Name Manager.
Links
Of course Microsoft documents how to do this. There is an introductory article on Microsoft MSDN:
Compatibility Between the 32-bit and 64-bit Versions of Office 2010
That article describes the how-to's to properly write the declarations. What is missing is which type declarations go with which API function or sub.
Microsoft has provided an updated version of the Win32API.txt with all proper declarations available for download here:
Office 2010 Help Files: Win32API_PtrSafe with 64-bit Support
When you run the installer after downloading the file
form the link above, it does not tell you where it installed the information.
Look in this -new- folder on your C drive:
C:\Office 2010 Developer Resources\Documents\Office2010Win32API_PtrSafe
You can find a list of the old Win32 API declarations here:
Visual Basic Win32 API Declarations
Microsoft also published a tool to check your code for 64 bit related problems, called the Microsoft Office Code Compatibility inspector addin.
API functions that were added/modified in 64-bit Windows: http://msdn.microsoft.com/en-us/library/aa383663(VS.85).aspx
API Functions by Windows release:
http://msdn.microsoft.com/en-us/library/aa383687(VS.85).aspx
Utter Access API declarations (a comprehensive list of many declarations)
Last, but certainly not least: Dennis Walentin has built an API viewer that is really helpful. You can find the API viewer here.
Declarations by API function
CloseClipboard
#If VBA7 Then
Declare PtrSafe Function CloseClipboard Lib "User32" () As LongPtr
#Else
Declare Function CloseClipboard Lib "User32" () As Long
#End If
Declare PtrSafe Function CloseClipboard Lib "User32" () As LongPtr
#Else
Declare Function CloseClipboard Lib "User32" () As Long
#End If
CopyMemory
#If VBA7 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByRef destination As Any, ByRef SOURCE As Any, ByVal Length As LongPtr)
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByRef destination As Any, ByRef SOURCE As Any, ByVal Length As Long)
#End If
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByRef destination As Any, ByRef SOURCE As Any, ByVal Length As LongPtr)
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByRef destination As Any, ByRef SOURCE As Any, ByVal Length As Long)
#End If
CreateProcess
This is a complicated one because it has a lot of arguments. A fully
functional example is included below the example declaration lines.
Courtesy:
The example
code was taken from this page
'Full example shown below, including the necessary
structures
#If VBA7 Then
Declare PtrSafe Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" (ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As SECURITY_ATTRIBUTES, _
lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, _
ByVal lpCurrentDriectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As LongPtr
Const INFINITE = &HFFFF
Const STARTF_USESHOWWINDOW = &H1
Private Enum enSW
SW_HIDE = 0
SW_NORMAL = 1
SW_MAXIMIZE = 3
SW_MINIMIZE = 6
End Enum
Private Type PROCESS_INFORMATION
hProcess As LongPtr
hThread As LongPtr
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Byte
hStdInput As LongPtr
hStdOutput As LongPtr
hStdError As LongPtr
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As LongPtr
bInheritHandle As Long
End Type
Private Enum enPriority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
#Else
Declare Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" (ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As SECURITY_ATTRIBUTES, _
lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, _
ByVal lpCurrentDriectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
Const INFINITE = &HFFFF
Const STARTF_USESHOWWINDOW = &H1
Private Enum enSW
SW_HIDE = 0
SW_NORMAL = 1
SW_MAXIMIZE = 3
SW_MINIMIZE = 6
End Enum
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Enum enPriority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
#End If
Private Function SuperShell(ByVal App As String, ByVal WorkDir As String, dwMilliseconds As Long, _
ByVal start_size As enSW, ByVal Priority_Class As enPriority_Class) As Boolean
Dim pclass As Long
Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
'Not used, but needed
Dim sec1 As SECURITY_ATTRIBUTES
Dim sec2 As SECURITY_ATTRIBUTES
'Set the structure size
sec1.nLength = Len(sec1)
sec2.nLength = Len(sec2)
sinfo.cb = Len(sinfo)
'Set the flags
sinfo.dwFlags = STARTF_USESHOWWINDOW
'Set the window's startup position
sinfo.wShowWindow = start_size
'Set the priority class
pclass = Priority_Class
'Start the program
If CreateProcess(vbNullString, App, sec1, sec2, False, pclass, _
0&, WorkDir, sinfo, pinfo) Then
'Wait
' WaitForSingleObject pinfo.hProcess, dwMilliseconds
SuperShell = True
Else
SuperShell = False
End If
End Function
Sub Test()
Dim sFile As String
'Set the dialog's title
sFile = Application.GetOpenFilename("Executables (*.exe), *.exe", , "")
SuperShell sFile, Left(sFile, InStrRev(sFile, "\")), 0, SW_NORMAL, HIGH_PRIORITY_CLASS
End Sub
#If VBA7 Then
Declare PtrSafe Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" (ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As SECURITY_ATTRIBUTES, _
lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, _
ByVal lpCurrentDriectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As LongPtr
Const INFINITE = &HFFFF
Const STARTF_USESHOWWINDOW = &H1
Private Enum enSW
SW_HIDE = 0
SW_NORMAL = 1
SW_MAXIMIZE = 3
SW_MINIMIZE = 6
End Enum
Private Type PROCESS_INFORMATION
hProcess As LongPtr
hThread As LongPtr
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Byte
hStdInput As LongPtr
hStdOutput As LongPtr
hStdError As LongPtr
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As LongPtr
bInheritHandle As Long
End Type
Private Enum enPriority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
#Else
Declare Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" (ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As SECURITY_ATTRIBUTES, _
lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, _
ByVal lpCurrentDriectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
Const INFINITE = &HFFFF
Const STARTF_USESHOWWINDOW = &H1
Private Enum enSW
SW_HIDE = 0
SW_NORMAL = 1
SW_MAXIMIZE = 3
SW_MINIMIZE = 6
End Enum
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Enum enPriority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
#End If
Private Function SuperShell(ByVal App As String, ByVal WorkDir As String, dwMilliseconds As Long, _
ByVal start_size As enSW, ByVal Priority_Class As enPriority_Class) As Boolean
Dim pclass As Long
Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
'Not used, but needed
Dim sec1 As SECURITY_ATTRIBUTES
Dim sec2 As SECURITY_ATTRIBUTES
'Set the structure size
sec1.nLength = Len(sec1)
sec2.nLength = Len(sec2)
sinfo.cb = Len(sinfo)
'Set the flags
sinfo.dwFlags = STARTF_USESHOWWINDOW
'Set the window's startup position
sinfo.wShowWindow = start_size
'Set the priority class
pclass = Priority_Class
'Start the program
If CreateProcess(vbNullString, App, sec1, sec2, False, pclass, _
0&, WorkDir, sinfo, pinfo) Then
'Wait
' WaitForSingleObject pinfo.hProcess, dwMilliseconds
SuperShell = True
Else
SuperShell = False
End If
End Function
Sub Test()
Dim sFile As String
'Set the dialog's title
sFile = Application.GetOpenFilename("Executables (*.exe), *.exe", , "")
SuperShell sFile, Left(sFile, InStrRev(sFile, "\")), 0, SW_NORMAL, HIGH_PRIORITY_CLASS
End Sub
DrawMenuBar
#If VBA7 Then
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
#End If
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
#End If
EmptyClipboard
#If VBA7 Then
Declare PtrSafe Function EmptyClipboard Lib "User32" () As LongPtr
#Else
Declare Function EmptyClipboard Lib "User32" () As Long
#End If
Declare PtrSafe Function EmptyClipboard Lib "User32" () As LongPtr
#Else
Declare Function EmptyClipboard Lib "User32" () As Long
#End If
FindWindow
#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
FindWindowEx
#If VBA7 Then
Private Declare PtrSafe Function FindWindowEx Lib "USER32" _
Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
#Else
Private Declare Function FindWindowEx Lib "USER32" _
Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
#End If
Private Declare PtrSafe Function FindWindowEx Lib "USER32" _
Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
#Else
Private Declare Function FindWindowEx Lib "USER32" _
Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
#End If
GdipCreateBitmapFromFile
#If VBA7 Then
Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As LongPtr, bitmap As LongPtr) As LongPtr
#Else
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
#End If
Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As LongPtr, bitmap As LongPtr) As LongPtr
#Else
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
#End If
GdipCreateHBITMAPFromBitmap
#If VBA7 Then
Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As LongPtr, hbmReturn As LongPtr, ByVal background As Long) As LongPtr
#Else
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
#End If
Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As LongPtr, hbmReturn As LongPtr, ByVal background As Long) As LongPtr
#Else
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
#End If
GdipDisposeImage
#If VBA7 Then
Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As LongPtr
#Else
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
#End If
Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As LongPtr
#Else
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
#End If
GdiplusShutdown
#If VBA7 Then
Private Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr) As LongPtr
#Else
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
#End If
Private Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr) As LongPtr
#Else
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
#End If
GdiplusStartup
#If VBA7 Then
Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As LongPtr
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As LongPtr
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
#Else
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
#End If
Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As LongPtr
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As LongPtr
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
#Else
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
#End If
GetClassName
#If VBA7 Then
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As LongPtr, ByVal lpClassName As String, _
ByVal nMaxCount As LongPtr) As Long
#Else
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
#End If
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As LongPtr, ByVal lpClassName As String, _
ByVal nMaxCount As LongPtr) As Long
#Else
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
#End If
GetDiskFreeSpaceEx
#If VBA7 Then
Private Declare PtrSafe Function GetDiskFreeSpaceEx Lib "kernel32" Alias _
"GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As _
Currency, lpTotalNumberOfFreeBytes As Currency) As LongPtr
#Else
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long
#End If
Private Declare PtrSafe Function GetDiskFreeSpaceEx Lib "kernel32" Alias _
"GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As _
Currency, lpTotalNumberOfFreeBytes As Currency) As LongPtr
#Else
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long
#End If
getDC
#If VBA7 Then
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
#Else
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
#End If
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
#Else
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
#End If
GetDesktopWindow
#If VBA7 Then
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
#Else
Private Declare Function GetDesktopWindow Lib "user32" () As Long
#End If
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
#Else
Private Declare Function GetDesktopWindow Lib "user32" () As Long
#End If
getDeviceCaps
#If VBA7 Then
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
#Else
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
#End If
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
#Else
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
#End If
GetDriveType
#If VBA7 Then
Private Declare PtrSafe Function GetDriveType Lib "kernel32" Alias _
"GetDriveTypeA" (ByVal sDrive As String) As LongPtr
#Else
Private Declare Function GetDriveType Lib "kernel32" Alias _
"GetDriveTypeA" (ByVal sDrive As String) As Long
#End If
Private Declare PtrSafe Function GetDriveType Lib "kernel32" Alias _
"GetDriveTypeA" (ByVal sDrive As String) As LongPtr
#Else
Private Declare Function GetDriveType Lib "kernel32" Alias _
"GetDriveTypeA" (ByVal sDrive As String) As Long
#End If
GetExitCodeProcess
#If VBA7 Then
Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" (ByVal _
hProcess As LongPtr, lpExitCode As Long) As Long
#Else
Declare Function GetExitCodeProcess Lib "kernel32" (ByVal _
hProcess As Long, lpExitCode As Long) As Long
#End If
Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" (ByVal _
hProcess As LongPtr, lpExitCode As Long) As Long
#Else
Declare Function GetExitCodeProcess Lib "kernel32" (ByVal _
hProcess As Long, lpExitCode As Long) As Long
#End If
GetForegroundWindow
#If VBA7 Then
Declare PtrSafe Function GetForegroundWindow Lib "user32.dll" () As LongPtr
#Else
Declare Function GetForegroundWindow Lib "user32.dll" () As Long
#End If
Declare PtrSafe Function GetForegroundWindow Lib "user32.dll" () As LongPtr
#Else
Declare Function GetForegroundWindow Lib "user32.dll" () As Long
#End If
getFrequency
#If VBA7 Then
Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
#Else
Private Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
#End If
Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
#Else
Private Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
#End If
GetKeyState
#If VBA7 Then
Declare PtrSafe Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#Else
Declare Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#End If
Declare PtrSafe Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#Else
Declare Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#End If
GetLastInputInfo
#If VBA7 Then
Private Type LASTINPUTINFO
cbSize As LongPtr
dwTime As LongPtr
End Type
Private Declare PtrSafe Sub GetLastInputInfo Lib "USER32" (ByRef plii As LASTINPUTINFO)
#Else
Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
Private Declare Sub GetLastInputInfo Lib "USER32" (ByRef plii As LASTINPUTINFO)
#End If
Private Type LASTINPUTINFO
cbSize As LongPtr
dwTime As LongPtr
End Type
Private Declare PtrSafe Sub GetLastInputInfo Lib "USER32" (ByRef plii As LASTINPUTINFO)
#Else
Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
Private Declare Sub GetLastInputInfo Lib "USER32" (ByRef plii As LASTINPUTINFO)
#End If
GetOpenFileName
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As LongPtr
lpfnHook As LongPtr
lpTemplateName As String
End Type
#Else
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
#End If
'/////////////////////////////////
'// End code GetOpenFileName //
'/////////////////////////////////
Private Function GetMyFile(strTitle As String) As String
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
OpenFile.lpstrFilter = ""
OpenFile.nFilterIndex = 1
OpenFile.hwndOwner = 0
OpenFile.lpstrFile = String(257, 0)
#If VBA7 Then
OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
OpenFile.lStructSize = LenB(OpenFile)
#Else
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lStructSize = Len(OpenFile)
#End If
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = "C:\"
OpenFile.lpstrTitle = strTitle
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
GetMyFile = ""
Else
GetMyFile = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
End If
End Function
#If VBA7 Then
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As LongPtr
lpfnHook As LongPtr
lpTemplateName As String
End Type
#Else
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
#End If
'/////////////////////////////////
'// End code GetOpenFileName //
'/////////////////////////////////
Private Function GetMyFile(strTitle As String) As String
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
OpenFile.lpstrFilter = ""
OpenFile.nFilterIndex = 1
OpenFile.hwndOwner = 0
OpenFile.lpstrFile = String(257, 0)
#If VBA7 Then
OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
OpenFile.lStructSize = LenB(OpenFile)
#Else
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lStructSize = Len(OpenFile)
#End If
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = "C:\"
OpenFile.lpstrTitle = strTitle
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
GetMyFile = ""
Else
GetMyFile = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
End If
End Function
GetSystemMetrics
#If VBA7 Then
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#End If
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#End If
GetTempPath
#If VBA7 Then
Private Declare PtrSafe Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (ByVal nBufferLength As LongPtr, _
ByVal lpbuffer As String) As Long
#Else
Private Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (ByVal nBufferLength As Long, _
ByVal lpbuffer As String) As Long
#End If
Private Declare PtrSafe Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (ByVal nBufferLength As LongPtr, _
ByVal lpbuffer As String) As Long
#Else
Private Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (ByVal nBufferLength As Long, _
ByVal lpbuffer As String) As Long
#End If
getTickCount
#If VBA7 Then
Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If
Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If
getTime
#If VBA7 Then
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
#Else
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
#End If
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
#Else
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
#End If
GetWindow
#If VBA7 Then
Private Declare PtrSafe Function GetWindow Lib "user32" _
(ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
#Else
Private Declare Function GetWindow Lib "user32" _
(ByVal hWnd As Long, ByVal wCmd As Long) As Long
#End If
Private Declare PtrSafe Function GetWindow Lib "user32" _
(ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
#Else
Private Declare Function GetWindow Lib "user32" _
(ByVal hWnd As Long, ByVal wCmd As Long) As Long
#End If
GetWindowLong
This is one of the few API functions that requires the Win64 compile constant:
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#End If
#Else
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
#End If
#If Win64 Then
Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#End If
#Else
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
#End If
GetWindowsDirectory
#If VBA7 Then
Private Declare PtrSafe Function GetWindowsDirectory& Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpbuffer As String, _
ByVal nSize As LongPtr)
#Else
Private Declare Function GetWindowsDirectory& Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpbuffer As String, _
ByVal nSize As Long)
#End If
Private Declare PtrSafe Function GetWindowsDirectory& Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpbuffer As String, _
ByVal nSize As LongPtr)
#Else
Private Declare Function GetWindowsDirectory& Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpbuffer As String, _
ByVal nSize As Long)
#End If
GetWindowText
#If VBA7 Then
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As LongPtr, ByVal lpString As String, _
ByVal cch As LongPtr) As Long
#Else
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long
#End If
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As LongPtr, ByVal lpString As String, _
ByVal cch As LongPtr) As Long
#Else
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long
#End If
GlobalAlloc
#If VBA7 Then
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
#Else
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
#End If
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
#Else
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
#End If
GlobalLock
#If VBA7 Then
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
#Else
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
#End If
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
#Else
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
#End If
InternetGetConnectedState
#If VBA7 Then
Private Declare PtrSafe Function InternetGetConnectedState _
Lib "wininet.dll" (lpdwFlags As LongPtr, _
ByVal dwReserved As Long) As Boolean
#Else
Private Declare Function InternetGetConnectedState _
Lib "wininet.dll" (lpdwFlags As Long, _
ByVal dwReserved As Long) As Boolean
#End If
Private Declare PtrSafe Function InternetGetConnectedState _
Lib "wininet.dll" (lpdwFlags As LongPtr, _
ByVal dwReserved As Long) As Boolean
#Else
Private Declare Function InternetGetConnectedState _
Lib "wininet.dll" (lpdwFlags As Long, _
ByVal dwReserved As Long) As Boolean
#End If
IsCharAlphaNumericA
#If VBA7 Then
Private Declare PtrSafe Function IsCharAlphaNumericA Lib "user32" (ByVal byChar As Byte) As Long
#Else
Private Declare Function IsCharAlphaNumericA Lib "user32" (ByVal byChar As Byte) As Long
#End If
Private Declare PtrSafe Function IsCharAlphaNumericA Lib "user32" (ByVal byChar As Byte) As Long
#Else
Private Declare Function IsCharAlphaNumericA Lib "user32" (ByVal byChar As Byte) As Long
#End If
lstrcopy
#If VBA7 Then
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
#Else
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
#End If
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
#Else
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
#End If
Mouse_Event
#If VBA7 Then
Private Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
ByVal dy As Long, ByVal cButtons As Long, _
ByVal dwExtraInfo As LongPtr)
#Else
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
ByVal dy As Long, ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)
#End If
Private Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Private Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
ByVal dy As Long, ByVal cButtons As Long, _
ByVal dwExtraInfo As LongPtr)
#Else
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
ByVal dy As Long, ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)
#End If
Private Const MOUSEEVENTF_MOVE = &H1 ' mouse move
OleCreatePictureIndirect
#If VBA7 Then
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr
Private Type PICTDESC
Size As Long
Type As Long
hPic As LongPtr
hPal As LongPtr
End Type
#Else
Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Type PICTDESC
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type
#End If
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr
Private Type PICTDESC
Size As Long
Type As Long
hPic As LongPtr
hPal As LongPtr
End Type
#Else
Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Type PICTDESC
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type
#End If
OpenClipboard
#If VBA7 Then
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
#Else
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
#End If
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
#Else
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
#End If
OpenProcess
#If VBA7 Then
Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal _
dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal _
dwProcessId As Long) As LongPtr
#Else
Declare Function OpenProcess Lib "kernel32" (ByVal _
dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal _
dwProcessId As Long) As Long
#End If
Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal _
dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal _
dwProcessId As Long) As LongPtr
#Else
Declare Function OpenProcess Lib "kernel32" (ByVal _
dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal _
dwProcessId As Long) As Long
#End If
ReleaseDC
#If VBA7 Then
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
#Else
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
#End If
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
#Else
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
#End If
SendMessage
#If VBA7 Then
Private Declare PtrSafe Function SendMessageA Lib "user32" (ByVal hWnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr
#Else
Private Declare Function SendMessageA Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
#End If
Private Declare PtrSafe Function SendMessageA Lib "user32" (ByVal hWnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr
#Else
Private Declare Function SendMessageA Lib "user32" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
#End If
SetActiveWindow
#If VBA7 Then
Private Declare PtrSafe Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
#Else
Private Declare Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
#End If
Private Declare PtrSafe Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
#Else
Private Declare Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
#End If
SetClipboardData
#If VBA7 Then
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As LongPtr
#Else
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
#End If
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As LongPtr
#Else
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
#End If
SetCurrentDirectory
#If VBA7 Then
Private Declare PtrSafe Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
#Else
Private Declare Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
#End If
Private Declare PtrSafe Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
#Else
Private Declare Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
#End If
SetWindowLongPtr
This is another one of the few API functions that require the Win64 compile constant:
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
Private Declare Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#End If
#Else
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If
#If Win64 Then
Private Declare PtrSafe Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
Private Declare Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#End If
#Else
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If
SetWindowPos
#If VBA7 Then
Private Declare PtrSafe Function SetWindowPos _
Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
#Else
Private Declare Function SetWindowPos _
Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
#End If
Private Declare PtrSafe Function SetWindowPos _
Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
#Else
Private Declare Function SetWindowPos _
Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
#End If
SHBrowseForFolder
#If VBA7 Then
Private Type BROWSEINFO
hOwner As LongPtr
pidlRoot As LongPtr
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As LongPtr
lParam As LongPtr
iImage As Long
End Type
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As LongPtr
#Else
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
#End If
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Type BROWSEINFO
hOwner As LongPtr
pidlRoot As LongPtr
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As LongPtr
lParam As LongPtr
iImage As Long
End Type
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As LongPtr
#Else
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
#End If
Private Const BIF_RETURNONLYFSDIRS = &H1
ShellExecute
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If
SHFileOperation
#If VBA7 Then
Type SHFILEOPSTRUCT
hWnd As LongPtr
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Longptr
sProgress As String
End Type
Declare PtrSafe Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As LongPtr
#Else
Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long
#End If
Type SHFILEOPSTRUCT
hWnd As LongPtr
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Longptr
sProgress As String
End Type
Declare PtrSafe Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As LongPtr
#Else
Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long
#End If
SHGetPathFromIDList
#If VBA7 Then
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean
#Else
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Boolean
#End If
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean
#Else
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Boolean
#End If
SHGetSpecialFolderLocation
#If VBA7 Then
Private Declare PtrSafe Function SHGetSpecialFolderLocation Lib _
"shell32.dll" (ByVal hwndOwner As LongPtr, ByVal nFolder As Long, _
pidl As ITEMIDLIST) As LongPtr
Private Type SHITEMID
cb As LongPtr
abID As Byte
End Type
#Else
Private Declare Function SHGetSpecialFolderLocation Lib _
"shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, _
pidl As ITEMIDLIST) As Long
Private Type SHITEMID
cb As Long
abID As Byte
End Type
#End If
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private Declare PtrSafe Function SHGetSpecialFolderLocation Lib _
"shell32.dll" (ByVal hwndOwner As LongPtr, ByVal nFolder As Long, _
pidl As ITEMIDLIST) As LongPtr
Private Type SHITEMID
cb As LongPtr
abID As Byte
End Type
#Else
Private Declare Function SHGetSpecialFolderLocation Lib _
"shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, _
pidl As ITEMIDLIST) As Long
Private Type SHITEMID
cb As Long
abID As Byte
End Type
#End If
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
timeGetTime
#If VBA7 Then
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
#Else
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
#End If
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
#Else
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
#End If
URLDownloadToFile
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If
Which Longs should become LongPtr?
It's actually pretty easy to determine what requires LongPtr and what can stay as Long. The only things that require LongPtr are function arguments or return values that represent addresses in memory. This is because a 64-bit OS has a memory space that is too large to hold in a Long data type variable. Arguments or return values that represent data will still be declared Long even in 64-bit.
The SendMessage API is a good example because it uses both types:
32-bit:
Private Declare
Function SendMessageA
Lib "user32" (ByVal
hWnd As Long,
ByVal wMsg As
Long, _
ByVal wParam As Long, lParam As Any) As Long
ByVal wParam As Long, lParam As Any) As Long
64 bit:
Private Declare
PtrSafe Function SendMessageA
Lib "user32" (ByVal
hWnd As LongPtr, ByVal
wMsg As Long,
_
ByVal wParam As LongPtr, lParam As Any) As LongPtr
ByVal wParam As LongPtr, lParam As Any) As LongPtr
The first argument -hWnd- is a window handle, which is an address in memory. The return value is a pointer to a function, which is also an address in memory. Both of these must be declared LongPtr in 64-bit VBA. The argument wMsg is used to pass data, so can be Long in both 32-bit and 64-bit.
How to determine what is a memory address and what is data? You just have to read the MSDN documentation for the API functions (the C++ version) and it will tell you. Anything called a handle, pointer, brush or any other object type will require a LongPtr in 64-bit. Anything that is strictly data can stay as Long.
Conditional compiling
If your code needs to run on both 32 bit and 64 bit Excel, then another thing to do is add conditional compilation to your VBA.
Microsoft devised two compile constants to handle this:
VBA7: True if you're using Office 2010, False for older versions
WIN64: True if your Office installation is 64 bit, false for 32 bit.
Since the 64 bit declarations also work on 32 bit Office 2010, all you have to test for is VBA7:
#If VBA7 Then
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
#Else
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
#End If
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
#Else
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
#End If
And then in the routine where this function is put to use:
#If VBA7 Then
Dim hDC As LongPtr
#Else
Dim hDC As Long
#End If
Dim lDotsPerInch As Long
'Get the user's DPI setting
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
Dim hDC As LongPtr
#Else
Dim hDC As Long
#End If
Dim lDotsPerInch As Long
'Get the user's DPI setting
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
Other API functions
Have a function declaration which is not on this list? I invite you to send me your (working and tested!!!) declarations so I can add them here.
I also welcome comments and suggestions on improvements!
Comments
Showing last 8 comments of 352 in total (Show All Comments):Comment by: Jan Karel Pieterse (7-12-2021 10:02:00) deeplink to this comment
Hi Diana,
Both functions are listed in the article, can you indicate what your issue is please?
Comment by: Belaki (3-3-2022 17:01:00) deeplink to this comment
O365 64-bit VBA Declarations for File Search API Calls:
Public Declare PtrSafe Function FindClose Lib "kernel32" ( _
ByVal hFindFile As LongPtr _
) As Long
Public Declare PtrSafe Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
ByVal lpFileName As String, _
lpFindFileData As WIN_32_FIND_DATA _
) As LongPtr
Public Declare PtrSafe Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
ByVal hFindFile As LongPtr, _
lpFindFileData As WIN_32_FIND_DATA _
) As LongPtr
Public Declare PtrSafe Function PathMatchSpec Lib "Shlwapi" Alias "PathMatchSpecW" ( _
ByVal pszFileParam As LongPtr, _
ByVal pszSpec As LongPtr _
) As Long
Comment by: Jan Karel Pieterse (3-3-2022 17:03:00) deeplink to this comment
Thanks Blake! Odd enough, the API docs have a different type for the FindNextFile function (it says it returns a Long). I'm inclined to think that is a typo and it should indeed be a LongPtr
Comment by: Belaki (3-3-2022 17:41:00) deeplink to this comment
Yup, I almost fell out of my chair when I got it to work, after several days of scratching my head...
Comment by: John Burger (5-4-2022 00:21:00) deeplink to this comment
It appears that GlobalAlloc has the VBA7 and Else declarations swapped. I believe it should be as below:
#If VBA7 Then
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
#Else
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
#End If
If not and it's correct as-is, then I recommend an explanation for why it otherwise seems backwards.
Comment by: Jan Karel Pieterse (5-4-2022 09:52:00) deeplink to this comment
Hi John,
You're right of course, I'll update the page ASAP, thanks!
Comment by: PAUL H HOSSLER (10-5-2022 13:35:00) deeplink to this comment
https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/longptr-data-type
"LongPtr is not a true data type because it transforms to a Long in 32-bit environments, or a LongLong in 64-bit environments. Using LongPtr enables writing portable code that can run in both 32-bit and 64-bit environments. Use LongPtr for pointers and handles."
It would seem that using PtrSafe and LongPtr would eliminate the need to use conditional compilation for many API calls in 32 vs 64 bit office. Is this correct?
Comment by: Jan Karel Pieterse (10-5-2022 14:41:00) deeplink to this comment
Hi Paul,
I think you are correct, but I've never tried. But as long as Office 2007 is still being used, you risk (an ever smaller) group of users that get a compile error.
Have a question, comment or suggestion? Then please use this form.
If your question is not directly related to this web page, but rather a more general "How do I do this" Excel question, then I advise you to ask your question here: www.eileenslounge.com.