Declaring API functions for 64 bit Office (and Mac Office)
Content
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.
All of these are Windows API calls. Some have Mac equivalents however
(like the CopyMemory one). I'll try to add those
as I find them.
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
#If VBA7 Then
Declare PtrSafe Function
CloseClipboard Lib "User32" ()
As LongPtr
#Else
Declare Function
CloseClipboard Lib "User32" ()
As Long
#End If
#If Mac Then
Private Declare
PtrSafe Function CopyMemory_byVar
Lib "libc.dylib" Alias "memmove" (ByRef
dest As Any, ByRef
src As Any, ByVal
size As Long)
As LongPtr
#Else
#If VBA7 Then
Public
Declare PtrSafe Sub
CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
_
(ByRef destination As
Any, ByRef SOURCE As
Any, ByVal Length As
LongPtr)
#Else
Public
Declare Sub CopyMemory
Lib "kernel32" Alias "RtlMoveMemory" _
(ByRef
destination As Any, ByRef
SOURCE As Any, ByVal
Length As Long)
#End If
#End If
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
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
#If VBA7 Then
Declare PtrSafe
Function EmptyClipboard
Lib "User32" () As
LongPtr
#Else
Declare Function
EmptyClipboard Lib "User32" ()
As Long
#End If
#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
#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
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
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
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
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
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
#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
#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
#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
#If VBA7 Then
Private Declare
PtrSafe Function GetDesktopWindow
Lib "user32" () As
LongPtr
#Else
Private Declare
Function GetDesktopWindow
Lib "user32" () As
Long
#End If
#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
#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
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
#If VBA7 Then
Declare PtrSafe
Function GetForegroundWindow
Lib "user32.dll" () As
LongPtr
#Else
Declare Function
GetForegroundWindow Lib "user32.dll" ()
As Long
#End If
#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
#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
#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
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 GetSystemMetrics
Lib "user32" (ByVal
nIndex As Long)
As Long
#Else
Private Declare
Function GetSystemMetrics
Lib "user32" (ByVal
nIndex As Long)
As Long
#End If
#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
#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
#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
#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
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 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
#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
#If VBA7 Then
Private Declare
PtrSafe Function GetWindowTextLength
Lib "user32" Alias "GetWindowTextLengthA" _
(ByVal
hWnd As LongPtr)
As Long
#Else
Private Declare
Function GetWindowTextLength
Lib "user32" Alias "GetWindowTextLengthA" _
(ByVal hWnd As
Long)
As Long
#End If
#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 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
#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
#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
#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
#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
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
#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
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
#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
#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
#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
#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
#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
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 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
#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
#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
#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
#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
#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
#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
#If VBA7 Then
Private Declare
PtrSafe Function URLDownloadToFile
Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal
pCaller As LongPtr,
_
ByVal
szURL As String,
ByVal szFileName As
String, _
ByVal
dwReserved As LongPtr,
ByVal lpfnCB As
LongPtr) 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
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
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
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)
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!