Subscribe
in a readerDeclaring API functions in 64 bit Office
Introduction
With the introduction of Windows 7 and Office 2010 VBA developers face a new challenge: ensuring their applications work on both 32 bit and 64 bit platforms.
This page is meant to become 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
Function name
Declarations (Declarations which contain the keyword
PtrSafe are 64 bit, without the keyword are 64 bit)
Declare PtrSafe Function
CloseClipboard Lib "User32" ()
As LongPtr
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function CloseClipboard Lib "User32" () As Long
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
Courtesy: The example code was taken from this page
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
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
'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
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
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
'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
Public Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
Public Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
#End If
Public Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
Public Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
#End If
Declare PtrSafe Function
EmptyClipboard Lib "User32" ()
As LongPtr
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare
Function FindWindow
Lib "USER32" Alias "FindWindowA"
(ByVal lpClassName
As String,
ByVal lpWindowName
As String)
As Long
Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
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
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
Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
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
GdipCreateBitmapFromFile
Private Declare
Function GdipCreateBitmapFromFile
Lib "GDIPlus" (ByVal
filename As
Long, bitmap As
Long) As
Long
Private Declare
PtrSafe Function GdipCreateBitmapFromFile
Lib "GDIPlus" (ByVal
filename As LongPtr, bitmap
As LongPtr)
As LongPtr
GdipCreateHBITMAPFromBitmap
Private Declare
Function GdipCreateHBITMAPFromBitmap
Lib "GDIPlus" (ByVal
bitmap As Long,
hbmReturn As
Long, ByVal
background As
Long) As
Long
Private Declare
PtrSafe Function GdipCreateHBITMAPFromBitmap
Lib "GDIPlus" (ByVal
bitmap As LongPtr, hbmReturn
As LongPtr,
ByVal background
As Long) As
LongPtr
GdipDisposeImage
Private Declare
Function GdipDisposeImage
Lib "GDIPlus" (ByVal
image As Long)
As Long
Private Declare
PtrSafe Function GdipDisposeImage
Lib "GDIPlus" (ByVal
image As LongPtr)
As LongPtr
GdiplusShutdown
Private Declare
Function GdiplusShutdown
Lib "GDIPlus" (ByVal
token As Long)
As Long
Private Declare
PtrSafe Function GdiplusShutdown
Lib "GDIPlus" (ByVal
token As LongPtr)
As LongPtr
GdiplusStartup
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
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
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
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As LongPtr
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Public Declare
Function GetClassName
Lib "USER32" Alias "GetClassNameA"
_
(ByVal hWnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Public Declare PtrSafe Function GetClassName Lib "USER32" Alias "GetClassNameA" _
(ByVal hWnd As LongPtr, ByVal lpClassName As String, _
ByVal nMaxCount As LongPtr) As Long
(ByVal hWnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Public Declare PtrSafe Function GetClassName Lib "USER32" Alias "GetClassNameA" _
(ByVal hWnd As LongPtr, ByVal lpClassName As String, _
ByVal nMaxCount As LongPtr) As Long
Private Declare
Function GetDiskFreeSpaceEx
Lib "kernel32" _
Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long
Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long
Private Declare
PtrSafe Function GetDiskFreeSpaceEx
Lib "kernel32" Alias _
"GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As _
Currency, lpTotalNumberOfFreeBytes As Currency) As LongPtr
"GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As _
Currency, lpTotalNumberOfFreeBytes As Currency) As LongPtr
Private Declare
Function GetDC
Lib "USER32" (ByVal
hWnd As Long)
As Long
Private Declare PtrSafe Function GetDC Lib "USER32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetDC Lib "USER32" (ByVal hWnd As LongPtr) As LongPtr
Public Declare
Function GetDesktopWindow
Lib "USER32" ()
As Long
Public Declare PtrSafe Function GetDesktopWindow Lib "USER32" () As LongPtr
Public Declare PtrSafe Function GetDesktopWindow Lib "USER32" () As LongPtr
Private Declare
Function GetDeviceCaps
Lib "gdi32" (ByVal
hDC As Long,
ByVal nIndex
As Long)
As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
Private Declare
Function GetDriveType
Lib "kernel32" Alias
_
"GetDriveTypeA" (ByVal sDrive As String) As Long
Private Declare PtrSafe Function GetDriveType Lib "kernel32" Alias _
"GetDriveTypeA" (ByVal sDrive As String) As LongPtr
"GetDriveTypeA" (ByVal sDrive As String) As Long
Private Declare PtrSafe Function GetDriveType Lib "kernel32" Alias _
"GetDriveTypeA" (ByVal sDrive As String) As LongPtr
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
Declare Function
GetForegroundWindow Lib "user32.dll"
() As Long
Declare PtrSafe Function GetForegroundWindow Lib "user32.dll" () As LongPtr
Declare PtrSafe Function GetForegroundWindow Lib "user32.dll" () As LongPtr
Declare Function
getFrequency Lib "kernel32"
Alias "QueryPerformanceFrequency" (cyFrequency
As Currency)
As Long
Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
#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
#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
Option Explicit
#If VBA7 Then
Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public 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
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public 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 //
'/////////////////////////////////
Public 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
Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public 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
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public 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 //
'/////////////////////////////////
Public 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
Private Declare
Function GetSystemMetrics
Lib "USER32" (ByVal
nIndex As Long)
As Long
Private Declare PtrSafe Function GetSystemMetrics Lib "USER32" (ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetSystemMetrics Lib "USER32" (ByVal nIndex As Long) As Long
Declare Function
GetTempPath Lib "kernel32"
_
Alias "GetTempPathA" (ByVal nBufferLength As Long, _
ByVal lpbuffer As String) As Long
Declare PtrSafe Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (ByVal nBufferLength As longptr, _
ByVal lpbuffer As String) As Long
Alias "GetTempPathA" (ByVal nBufferLength As Long, _
ByVal lpbuffer As String) As Long
Declare PtrSafe Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (ByVal nBufferLength As longptr, _
ByVal lpbuffer As String) As Long
Private Declare
Function getTickCount
Lib "kernel32" Alias "QueryPerformanceCounter"
(cyTickCount As
Currency) As
Long
Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
'
Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
'
Private Declare
Function timeGetTime
Lib "winmm.dll" ()
As Long
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
Public Declare
Function GetWindow
Lib "USER32" _
(ByVal hWnd As Long, ByVal wCmd As Long) As Long
Public Declare PtrSafe Function GetWindow Lib "USER32" _
(ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
(ByVal hWnd As Long, ByVal wCmd As Long) As Long
Public Declare PtrSafe Function GetWindow Lib "USER32" _
(ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
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
Declare Function
GetWindowsDirectory& Lib "kernel32"
Alias _
"GetWindowsDirectoryA" (ByVal lpbuffer As String, _
ByVal nSize As Long)
Declare PtrSafe Function GetWindowsDirectory& Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpbuffer As String, _
ByVal nSize As LongPtr)
"GetWindowsDirectoryA" (ByVal lpbuffer As String, _
ByVal nSize As Long)
Declare PtrSafe Function GetWindowsDirectory& Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpbuffer As String, _
ByVal nSize As LongPtr)
Public Declare
Function GetWindowText
Lib "USER32" Alias "GetWindowTextA"
_
(ByVal hWnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long
Public Declare PtrSafe Function GetWindowText Lib "USER32" Alias "GetWindowTextA" _
(ByVal hWnd As LongPtr, ByVal lpString As String, _
ByVal cch As LongPtr) As Long
(ByVal hWnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long
Public Declare PtrSafe Function GetWindowText Lib "USER32" Alias "GetWindowTextA" _
(ByVal hWnd As LongPtr, ByVal lpString As String, _
ByVal cch As LongPtr) As Long
Declare PtrSafe Function
GlobalAlloc Lib "kernel32" (ByVal
wFlags As Long,
ByVal dwBytes
As LongPtr)
As LongPtr
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare PtrSafe Function
GlobalLock Lib "kernel32" (ByVal
hMem As LongPtr)
As LongPtr
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare
Function InternetGetConnectedState
_
Lib "wininet.dll" (lpdwFlags As Long, _
ByVal dwReserved As Long) As Boolean
Public Declare PtrSafe Function InternetGetConnectedState _
Lib "wininet.dll" (lpdwFlags As LongPtr, _
ByVal dwReserved As long) As Boolean
Lib "wininet.dll" (lpdwFlags As Long, _
ByVal dwReserved As Long) As Boolean
Public Declare PtrSafe Function InternetGetConnectedState _
Lib "wininet.dll" (lpdwFlags As LongPtr, _
ByVal dwReserved As long) As Boolean
Private Declare
Function IsCharAlphaNumericA
Lib "USER32" (ByVal
byChar As Byte)
As Long
Private Declare PtrSafe Function IsCharAlphaNumericA Lib "USER32" (ByVal byChar As Byte) As Long
Private Declare PtrSafe Function IsCharAlphaNumericA Lib "USER32" (ByVal byChar As Byte) As Long
Declare PtrSafe Function
lstrcpy Lib "kernel32" (ByVal
lpString1 As Any,
ByVal lpString2
As Any) As
LongPtr
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
#If VBA7 Then
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
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
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
Private Type PICTDESC
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type
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
Private Type PICTDESC
Size As Long
Type As Long
hPic As LongPtr
hPal As LongPtr
End Type
Declare PtrSafe Function
OpenClipboard Lib "User32" (ByVal
hwnd As LongPtr)
As LongPtr
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
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
Private Declare
Function ReleaseDC
Lib "USER32" (ByVal
hWnd As Long,
ByVal hDC As
Long) As
Long
Private Declare PtrSafe Function ReleaseDC Lib "USER32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
Private Declare PtrSafe Function ReleaseDC Lib "USER32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
Public 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
Public 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
Declare Function
SetActiveWindow Lib "user32.dll"
(ByVal hWnd
As Long)
As Long
Declare PtrSafe Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
Declare PtrSafe Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As LongPtr) As LongPtr
Declare PtrSafe Function
SetClipboardData Lib "User32"
(ByVal wFormat
As LongPtr,
ByVal hMem
As LongPtr)
As LongPtr
Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare
Function SetCurrentDirectoryA
Lib "kernel32" (ByVal
lpPathName As
String) As
Long
Private Declare PtrSafe Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
This is one of the few API functions that requires 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
#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
#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
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
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
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
#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
Private Declare
Function SHGetPathFromIDList
Lib "shell32.dll" Alias "SHGetPathFromIDListA"
_
(ByVal pidl As Long, ByVal pszPath As String) As Boolean
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean
(ByVal pidl As Long, ByVal pszPath As String) As Boolean
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean
#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
Private Declare
Function timeGetTime
Lib "winmm.dll" ()
As Long
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
#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:
Public 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:
Public 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!
Sorry for the truncations into 3 messages
George
Comment by: Jan Karel Pieterse (8-8-2013 21:03:19) Hi George,
Thanks!!
Comment by: Jan Karel Pieterse (8-8-2013 21:04:11) Hi George,
The best way is to find womeone with 64 bit Excel to test this.
Comment by: Daniel Isoje (29-12-2013 20:33:10) Your post makes it all easy for me now. Before now the 32/64bit issues have been troubling my mind as an access developer.
Many thanks.
Comment by: Erwin Kalvelagen (19-3-2014 16:54:16) Just as a warning: I believe the file Win32API_PtrSafe.TXT contains some errors wrt Excel 64 bit. I got a few "Microsoft Excel has stopped working errors". Most are related to strings.
Here are some details:
http://social.msdn.microsoft.com/Forums/office/en-US/9ad49156-0d29-4c0c-ae30-8e7c11ccd8cf/win32apiptrsafetxt-better-version-available?forum=exceldev
Comment by: Thomas Dette (30-7-2014 10:44:41) Hi,
do you have a "64bit translation" for following APIs
Declare Function SleepEx Lib "kernel32" (ByVal dwMilliseconds As Long, ByVal bAlertable As Long) As Long
Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal dwFlags As Long) As Long
Declare Function sndPlaySound Lib "winmm.dll" snd dPlaySoundA" ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Declare Function WritePrivateProfileString& Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, _
ByVal lplFileName As String)
Declare Function GetPrivateProfileString& Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String)
Using ACCESS 2010 64bit.
Thanks for helping.
Thomas.
Comment by: Frank Barsnick (1-9-2014 13:37:24) Hi,
do you have a "64bit translation" for following APIs for reading an writing INI-files:
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, lpString As Any, ByVal lplFileName As String) As Integer
Private Declare Function DeletePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal Section As String, ByVal NoKey As Long, ByVal NoSetting As Long, ByVal FileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, lpString As Any, ByVal lplFileName As String) As Integer
Private Declare Function DeletePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal Section As String, ByVal NoKey As Long, ByVal NoSetting As Long, ByVal FileName As String) As Long
Thx for your help,
Frank
Comment by: Jan Karel Pieterse (1-9-2014 14:29:45) Hi Frank,
Sure:
Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
I was unable to find the Delete one though!
Comment by: Alexander (29-9-2014 12:32:47) Error in declaration SHBrowseForFolder. To 64-bit returned type must be LongPtr:
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As LongPtr
Comment by: Jan Karel Pieterse (29-9-2014 13:09:12) Hi Alexander,
Thanks for pointing that out!
I have edited the page accordingly.
Comment by: LHEN (20-10-2014 10:20:12) Hi,
do you have a "64bit translation" for following APIs?
Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
'Returns the socket error
Public Declare Function WSAStartup Lib "WSOCK32.DLL" _
(ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
'Initialize sockets
Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
'Clean up sockets
Public Declare Function gethostname Lib "WSOCK32.DLL" _
(ByVal szHost As String, ByVal dwHostLen As Long) As Long
'Get Host Name
Public Declare Function gethostbyname Lib "WSOCK32.DLL" _
(ByVal szHost As String) As Long
Many thanks :)
Comment by: Jan Karel Pieterse (20-10-2014 10:26:56) Hi LHEN,
I'm sorry, but I don't.
Best to search MSDN for the functions and try to translate them yourself.
Comment by: Dave (14-11-2014 04:35:26) Nice Work Jan!
Comment by: Nigel Heffernan (14-11-2014 16:41:48) OpenProcess and GetExitCodeProcess would be useful: both are required for the widely-used ShellAndWait() function.
Note that they are quite tricky: while the handles and pointers are clearly LongPtr in the 64-bit environment, it's not clear whether the Process ID and the exit codes are Long or LongLong integers.
Comment by: Jan Karel Pieterse (17-11-2014 09:46:08) Hi Nigel,
Added!
Comment by: Zak (19-11-2014 11:08:33) Hi,
Hi to All,
Can anyone help me regarding my problem?
This is the scenario.
I have a .mdb file generated using Access 2010.
I tried to open the file using Access 2013.
After some modifications in the connections, I have a problem.
I have a browse button that when I click, resulted to this error.
Run-time Error '452'
Can't find DLL entry point 59 in msaccess.exe
When I debug, I think this portion have problem.
Declare PtrSafe Sub ms_accSplitPath Lib "msaccess.exe" Alias "#59" _
(ByVal strPath As String, ByVal strDrive As String, _
ByVal strDir As String, ByVal strFName As String, ByVal strExt As String)
(ByVal strPath As String, ByVal strDrive As String, _
ByVal strDir As String, ByVal strFName As String, ByVal strExt As String)
*I just added the PtrSafe for 64-bit.
I will surely appreciate all your feedbacks.
Thank you very much.
Comment by: Dan (27-11-2014 13:18:44) Hi,
I need to make my code available to 32-Bit & 64-Bit Excel users, with both VBA7 and earlier verisons.
Can I not just use the
#if VBA7
statement to replace all Long with LongPtr for VBA7 environments? Surely this will just evaluate to long in 32-bit and longlong in 64-bit?
I'm failing to see how this could be detrimental. Why should I be only converting certain Longs to LongPtr?
Any guidance is appreciated.
Comment by: Jan Karel Pieterse (27-11-2014 14:31:29) Hi Dan,
To be honest, I'm not entirely sure what to answer here. My gut feeling says that the arguments you pass to a Win API need to be of the right type. I am not convinced LongPtr would be equally good as Long when the argument is supposed to be a Long. My gut feeling also whispers to me that this is the type of thing that lets vulnerabilities creep into software, but perhaps I'm paranoid :-) .
Comment by: Nigel Heffernan (21-1-2015 18:10:05) Hi Jan -
Thanks for the code for OpenProcess and GetExitCodeProcess.
I notice that you're not using LongLong anywhere in these declarations: do you have examples of Win64 API functions that do require them?
This isn't a matter of idle curiosity: other VBA Gurus are peppering their API declarations with LongLong and I think that they are occasionally wrong - but I think they are safer doing that than taking the risk of receiving a LongLong resource identifier or parameter into a Long integer, and passing the truncated result into another API call. Windows might throw an exception that VBA can handle as an error; it might crash Excel; or it might truncate the value silently and perform some arcane API function on the wrong resource.
Also, there are environments where LongPtr is available, but LongLong isn't.
This means that GetWindowLong isn't the only API declaration that needs three separate segments of conditional compilation; take a look at this, and consider what it means if the only place I can put a breakpoint is
'lParam = 6432'
Public Sub TestEnv()
#If VBA7 And Win64 Then
' 64 bit Excel under 64-bit windows
' We can use LongPtr and LongLong
Dim hWnd As LongPtr
Dim lParam As LongLong
lParam = 6464
#ElseIf VBA7 Then
' 64 bit Excel in all environments
' We can use LongPtr
Dim hWnd As LongPtr
Dim lParam As Long
lParam = 6432
#Else
' 32 bit Excel
' Any length you like, as long as it's Long
Dim hWnd As Long
Dim lParam As Long
lParam = 32
#End If
End Sub
I think we've all underestimated the complexity of the task we face in upgrading VBA code to 64-bit.
Comment by: Nigel Heffernan (21-1-2015 19:41:16) Dan,
You need to do some reading on Pointers, and why 'PtrSafe' matters. Google for 'Dangling Pointer' and see what you get.
What follows is my own understanding, in the language we use as VBA developers; and I am well aware that it contains oversimplifications that push it beyond mere errors and into the logical abyss that philosophers refer to as 'Not Even Wrong'.
A Pointer is the memory address of a resource - maybe the address of the Long integer you're using right now; maybe the address of an object which needs to be in memory when you need it, or a window handle; or, maybe, the address of a function that an API Timer has been told to call in sixty seconds' time.
When that address is incorrect, or when the resource at that address isn't what you expected, things can go badly wrong; so Microsoft have introduced new functions labelled 'Pointer-Safe', which use a special type of integer called 'LongPtr' for memory addresses; and a compiler that reads 'PtrSafe' and 'LongPtr' will create runtime code with new, improved, error-tolerant logic to manage these pointers and the resources in the memory addresses they point to.
You can still store addresses in a LongLong integer: a pointer is just a number. But the compiler won't do that new, improved pointer management on any old integer: you need to declare it as 'LongPtr'.
I do not know what will happen if you declare an everyday integer as a LongPtr, and use it in your code as (say) a loop counter.
My best guess is that things will run very slowly - every time the integer is changed, there will be a series of uneccessary checks to see if there's a memory address with a pointer already using 'your' number - and I would guess that an error-handler (or a complicated redirection and reallocation routine) will be called whenever your integer-declared-as-LngPtr is changed to a value that represents a pointer to memory that's already in use.
Let me know how your application works when you try that.
Comment by: John (19-3-2015 22:38:51) Hello, I have a problem with system tray icon. Icon cannot show and after minimized nothing happened. Do you know how to update vba code to win7 64bit?
Best regards
Comment by: Jan Karel Pieterse (20-3-2015 13:42:45) Hi John,
What code?
Comment by: Randy (28-4-2015 05:58:08) How do you get VBA to recognize the VBA7 constant? I'm running Office 2010 64-bit Excel. I declared a DLL function as follows:
[VB code below]
#IF VBA7 then
Declare PtrSafe Function ...
#ELSE
Declare Function ...
#END IF
Comments
All comments about this page:
Comment by: Alexander Wolff (28-1-2010 12:01:43)
- PtrSafe before "Function"
- LongPtr instead of "Long" (in some cases)
IsCharAlphaNumericA: "#Else" is probably not intended to be there?
Comment by: Jan Karel Pieterse (29-1-2010 02:40:08)
Thanks for spotting the anomalies. Care to tell me which Long's must become LongPtr's?
Comment by: Ron Anderson (3-5-2010 17:13:21)
Comment by: Jan Karel Pieterse (4-5-2010 00:36:23)
Unfortunately, I have never used that application before, so I am not in the position to advise. I would suggest to contact the manufacturer about your problem.
Comment by: Anders Hauge (20-5-2010 10:35:46)
Notice that the new file is called Win32API_PtrSafe.TXT and by default is installed to: C:\Office 2010 Developer Resources\
Comment by: Jan Karel Pieterse (21-5-2010 01:37:45)
Comment by: Yuhong Bao (6-6-2010 00:23:09)
"Private Declare PtrSafe Function GetWindowLongptr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr"
Wrong, sorry. I think the best bet here is to use Win64 instead of VBA7 and use Alias "GetWindowLongPtrA" and Alias "SetWindowLongPtrA". That is how it is defined in the headers.
Comment by: Jan Karel Pieterse (6-6-2010 23:09:30)
Thanks. Could you perhaps show the proper declarations in full?
Comment by: Yuhong Bao (6-6-2010 23:14:06)
Private Declare PtrSafe Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
Note that this Declare should be conditialized on Win64 instead of VB7, because Get/SetWindowLongPtr do not exist as an export on 32-bit Windows.
Comment by: Jan Karel Pieterse (7-6-2010 00:21:24)
Thanks!
Comment by: Yuhong Bao (7-6-2010 13:15:58)
Private Declare PtrSafe Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Comment by: Clarence (14-7-2010 08:43:57)
Comment by: Jan Karel Pieterse (14-7-2010 10:58:42)
No, but you will need code like the following:
#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
Comment by: Villable (16-8-2010 10:53:06)
Why?
How can i do faster my macros at 64 bits?.
Thanks
Comment by: Jan Karel Pieterse (16-8-2010 11:16:35)
Depends on the code. Could you post some of it?
Comment by: Villable (16-8-2010 15:38:09)
----------------
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Union(Target, Range("L5")).Address = _Range("L5").Address Then Call Calendario
End Sub
---------------
Private Sub Calendario()
ActiveSheet.Unprotect ("BCG")
f = Cells(1, 1) 'f=fila de comienzo
ff = Cells(1, 2) 'ff=fila final
m = Range("L5").Value 'm = mes
If ff > f Then Range("A" & f & ":A" & ff).EntireRow.Delete shift:=xlUp 'delete existing report
'New report
For o = Hoja3.Cells(1, 1) To Hoja3.Cells(1, 2)
Range("A2:A3").EntireRow.Copy'copy line
Rows(f).EntireRow.Insert shift:=xlDown 'insert line
Range("A" & f & ":A" & f + 1).EntireRow.Hidden = False 'show line
Cells(f, 1) = Hoja3.Cells(o, 1)
Cells(f, 2) = Hoja3.Cells(o, 2)
Hoja2.Range("AP3").Value = Hoja3.Cells(o,1)
f = f + 1
p = Hoja2.Cells(1, 1)
ff = Hoja2.Cells(1, 2) - 25
While p < ff
If Hoja2.Cells(p - 1 + m * 2, 42).Value > 0 Then
Rows(4).EntireRow.Copy
Rows(f).EntireRow.Insert shift:=xlDown
Rows(f).EntireRow.Hidden = False
Cells(f, 1) = Hoja3.Cells(o, 1)
Cells(f, 2) = Hoja2.Cells(p, 1).Value
Cells(f, 3) = (p - 5) / 26
Cells(f, 4) = Hoja2.Cells(p + m * 2, 42)
Cells(f, 6) = Hoja2.Cells(p - 1 + m * 2, 42) / Hoja2.Cells(p - 1 + m * 2, 36) * 100
f = f + 1
End If
p = p + 26
Wend
f = f + 1
Cells(f, 1).Select
Next
FIN:
Cells(Cells(1, 1), 1).Select
ActiveSheet.Protect ("BCG")
Beep
End Sub
----------------
Thanks
Comment by: Jan Karel Pieterse (16-8-2010 23:12:21)
I see no obvious reason for the slowness of your code on 64 bit. But you may benefit from turning off screenupdating and calculation when the code starts:
Application.Calculation = xlCalculationManual
'Your code goes here
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Comment by: Villable (17-8-2010 01:01:53)
Variable 'o' goes from 1 to 20 and variable 'p' goes from 1 to 42. So in 64 bits it takes, at least, AN HOUR while in 32 bits it takes 15 SECONDS!!!
I don't know which is the difference. I think is a bug of Office 2010 64bits, and i'm thinking about install 32 bits to get that problems off.
Thank you anyway.
Comment by: Doug Drada (11-10-2010 07:46:38)
Comment by: Jan Karel Pieterse (11-10-2010 07:58:19)
Please post them!
Can't you combine them into one post?
If unsure, please go ahead and send me an email (see bottom of page).
Comment by: Boomer57 (26-11-2010 16:17:06)
Great site!
Since I'm cutting and pasting this code into VBA7, wrapping each api call with the:
#If VBA7 Then
.... 'New 64-bit declarations here...
#Else
.... 'Legacy 32-bit declarations here...
#End If
would be appreciated.
Thank you!!!
Comment by: Excelo (11-12-2010 12:01:34)
Comment by: Tomas (15-12-2010 11:45:56)
As I'am no expert in this matter i feel the need to ask for help on this matter.
I cant get these Api declarations to work with a 64bit office version. The 32bit declarations work fine...
thanks in advance
Tomas
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
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 IntPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As Any) As LongPtr
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
#End If
Comment by: Jan Karel Pieterse (16-12-2010 01:22:18)
The type IntPtr does not exist (second declare statement in your code)
Comment by: Tomas (16-12-2010 12:15:34)
Comment by: Satyendra (3-2-2011 08:04:12)
Can you help me, to place LongPtr insted of Long in delarations. I am posting all my declarations in 2 or 3 posts. Because here I can't post more then 2000 chars in one post
Public Declare PtrSafe Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSADATA As WSADATA) As Long
Public Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare PtrSafe Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
Public Declare PtrSafe Function gethostname Lib "wsock32.dll" (ByVal host_name As String, ByVal namelen As Integer) As Integer
Public Declare PtrSafe Function setsockopt Lib "wsock32.dll" (ByVal S As Long, ByVal level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long
Public Declare PtrSafe Function w_socket Lib "wsock32.dll" Alias "socket" (ByVal lngAf As Long, ByVal lngType As Long, ByVal lngProtocol As Long) As Long
Public Declare PtrSafe Function w_closesocket Lib "wsock32.dll" Alias "closesocket" (ByVal socketHandle As Long) As Long
Public Declare PtrSafe Function w_bind Lib "wsock32.dll" Alias "bind" (ByVal SOCKET As Long, Name As SOCKADDR_IN, ByVal namelen As Long) As Long
Public Declare PtrSafe Function w_connect Lib "wsock32.dll" Alias "connect" (ByVal SOCKET As Long, Name As SOCKADDR_IN, ByVal namelen As Long) As Long
Public Declare PtrSafe Function w_send Lib "wsock32.dll" Alias "send" (ByVal SOCKET As Long, buf As Any, ByVal length As Long, ByVal Flags As Long) As Long
Public Declare PtrSafe Function w_sendTo Lib "wsock32.dll" Alias "sendto" (ByVal SOCKET As Long, buf As Any, ByVal length As Long, ByVal Flags As Long, remoteAddr As SOCKADDR_IN, ByVal remoteAddrSize As Long) As Long
Public Declare PtrSafe Function w_recv Lib "wsock32.dll" Alias "recv" (ByVal SOCKET As Long, buf As Any, ByVal length As Long, ByVal Flags As Long) As Long
Comment by: Jan Karel Pieterse (3-2-2011 11:38:52)
I'm sorry I can't help you with that on short notice, I'm way too busy to do this for you.
I suggest you to find the information on each of the functions you mention on the Microsoft MSDN site:
http://msdn.microsoft.com/en-us/library/aa383749(v=vs.85).aspx
Like I mentioned above:
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.
Comment by: Satyendra (4-2-2011 01:24:48)
Thanks for your quick response. I tried to find those functions in your given MSDN site. But I didn't find any one of them. Can you help me sort this issue or suggest some good material where I can get all these function syntaxes.
Satyendra
Comment by: Jan Karel Pieterse (4-2-2011 03:28:51)
I think you'll find your information here:
http://msdn.microsoft.com/en-us/library/ms741394(VS.85).aspx
Comment by: Satyendra (7-2-2011 10:14:42)
I modified all the declarations, except the select statement. Can you please help to modify it.
Public Declare PtrSafe Function w_select Lib "wsock32.dll" Alias "select" (ByVal nfds As Long, readFds As fd_set, writeFds As fd_set, exceptFds As fd_set, timeout As timeval) As Long
Satyendra
Comment by: Maria (4-4-2011 11:40:45)
I still get compile errors on the 32 bit declares. What am I missing?
I am using Excel 64 bit (14.0.5128.5000 64 bit) and Windows 7 Professional (64 bit).
Comment by: Jan Karel Pieterse (4-4-2011 23:23:49)
Can you post your code and indicate what line gets highlighted when the compile error is shown?
Comment by: Maria (7-4-2011 09:08:45)
---------------------------------------------
#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
'>>>>>>> The next line is the line that will not compile <<<<<<<<<<<<<
Private Declare Sub GetLastInputInfo Lib "USER32" (ByRef plii As LASTINPUTINFO)
#End If
Comment by: Pablo (7-4-2011 16:36:54)
Comment by: Jan Karel Pieterse (8-4-2011 02:39:40)
Odd, as those line should never be reached in 64 bit Excel and they do not give a compile error on my 32 bit Excel 2010. Do you happen to have any references indicated as missing?
Comment by: Maria (8-4-2011 06:08:08)
The following references are checked:
- Visual Basic For Applications
- Microsoft Excel 14.0 Object Library
- OLE Automation
- Microsoft Office 14.0 Object Library
I quickly scrolled through the entire reference list and did not see anything marked "Missing".
Comment by: Maria (9-4-2011 10:07:17)
32 bit declares. I guess one of the libraries was corrupted. Thank
you for your time.
Comment by: Jan Karel Pieterse (9-4-2011 10:08:39)
Thanks for letting me know, great you could solve your problem.
NB: in the references list, the checked ones are always at the top and those are also the only ones that might be marked "MISSING", so there is no need to scroll down.
Comment by: Ulrik (11-5-2011 22:30:56)
Win32API_PtrSafe.txt contains the following:
32-bit (x86) and 64-bit (x64) compatible Declare statements for the Windows API functions that were included in the original Win32API.txt file.
Global constant declarations for the constants that the provided Declare statements use.
Type declarations for the user-defined types (structures) that the provided Declare statements use.
http://www.microsoft.com/downloads/en/confirmation.aspx?FamilyID=035b72a5-eef9-4baf-8dbc-63fbd2dd982b&displaylang=en
Comment by: Jan Karel Pieterse (12-5-2011 00:56:41)
Thanks for the link!
NB: what isn't mentioned is that the executable unzips the information to this folder on your hard drive:
C:\Office 2010 Developer Resources\Documents\Office2010Win32API_PtrSafe
Comment by: Gregory Morse (8-6-2011 02:25:19)
typedef UINT_PTR WPARAM;
#if defined(_WIN64)
typedef unsigned __int64 UINT_PTR;
#else
typedef unsigned int UINT_PTR;
#endif
Comment by: Jan Karel Pieterse (8-6-2011 07:54:53)
Thanks!
Maybe you're right, I'll have to check.
Comment by: Karen (29-6-2011 10:24:36)
Comment by: Jan Karel Pieterse (30-6-2011 00:19:11)
I've included the function, see top of the table on this page.
Comment by: Martin Orlicky (20-7-2011 08:21:45)
Concrete, these two commands don't work:
1. Set mymenu = Application.CommandBars.Add(Name:="Test_Check_Toolbar", Position:=msoBarBottom, Temporary:=True)
2. Function APR_calc(RIV As Double, Payment_Frequency As Integer, term As Integer, grace_period As Integer, first_pmt As Double, weekly_pmt As Double, final_pmt As Double)
May you please help somehow? Thanks, Martin
Comment by: Jan Karel Pieterse (22-7-2011 07:32:49)
Unfortunately, you cannot use 32 bit controls in 64 bit Office and the Office Web controls are strictly 32 bit.
So you will have to revert to a different method entirely.
If you want to be sure an Excel application works on both 32 and 64 bit, use only the built-in Office controls.
I'm a bit surprised the 1st command does not work, but I strongly suspect this is due to the missing reference.
Comment by: Rx_ (30-9-2011 08:35:48)
My client uses Citrix to distribut my MS Access application that uses Windows API declare statements.
The article describes Office 2007 32/64 bit. And most users are probably running from Windows 7. Can you please exapand on a situation for migrating to Windows Server 2008 R2 and the 32 Bit of Office 2010? Is the PrtSafe required for this or could there be other factors?
Moving a working application over to the new server this week, the API functions fail.
New server: Windows Server 2008 R2 Office 2010 32 Bit
The exact same Access code is still working fine on the Windows Server 2003 using Office 2007.
Best Regards
Rx
Tesla 3D, Denver
Comment by: Jan Karel Pieterse (2-10-2011 23:46:11)
As long as your users are on 32 bit Office your API declarations should work unchanged.
Comment by: Rx_ (3-10-2011 08:02:05)
On a Windows 7 (64 bit) with Office 2010, the error message that the DLL must be updated with PrtSafe is required (as we all expected.
Back at the customer site, the same copy was run on a new Windows 7 Enterprise (32 bit) with Office 2010. It still fails. Setting the MS Access 2010 exe running as administrator in Compatibility Mode for XP sp 3 - it still fails.
Another site recommend checking the Err.LastDllError at various points in the code. And, suggested that there are some DLL for Windows 7 that may have to be upgraded.
Rx Tesla 3D, Denver
Comment by: Jan Karel Pieterse (4-10-2011 04:32:45)
The files I tried work on any Office version since Office 97 up to and including 2010.
Are you SURE this isn't a 64 bit version of Excel?
Comment by: Ger (12-10-2011 12:52:57)
My own scenario is: Office 2007 (32 bit), Office 2010 (32 bit) and Office 2010 (64 bit). Code and declarations need to work on all of them.
I cant just use #if VBA7 then use LongLong and LngPtr declarations, because if I do this it will fail to compile on Office 2010 32 bit with a "User Defined Type Not defined" and highlighting the line that contains LongLong
Granted, the compiler statement works fine on Office 2010 64 bit.
The #Else part of the conditional statement catches the compiler for Office 2007 32 bit and there arent any issues there.
But to get declarations to work correct across the three platforms, I believe I need to use the win64 constant, as per the MS 2010 Help file:
' Conditional Compilation Example
#If Vba7 Then
' Code is running in the VBA7 editor.
#If Win64 Then
' Code is running in 64-bit development environment.
#Else
' Code is not running in 64-bit development environment.
#End If
#Else
' Code is not running in the VBA7 editor.
#End If
It makes the declarations awfully long!!!!
Of course, I could be doing something wrong too. :-)
Appreciate the feedback. I can post my current declarations if you wish to see them to cover all 3 platforms (GetActiveWindow, ChooseColorDlg).
Ger
Comment by: Jan Karel Pieterse (12-10-2011 23:48:43)
Thanks for the comments. All declarations shown here should work on those versions, but I guess there may be situations where the win64 compile constant is needed. If you have an example, please post it here and I will include it in the article text!
Comment by: Ger Plante (13-10-2011 02:39:19)
Let me know if you need me to email it to a different address.
Best Regards
Ger
Comment by: Jan Karel Pieterse (13-10-2011 04:29:07)
Email received and replied-to, thanks.
Comment by: Jochen Wezel (20-10-2011 02:40:04)
Option Explicit
Option Compare Database
Public Enum OfficePlatformVersion
Office64 = 2
Office32 = 1
End Enum
Public Function DetectOfficeVbaVersion() As Integer
#If VBA10 Then
DetectOfficeVbaVersion = 10
#ElseIf VBA9 Then
DetectOfficeVbaVersion = 9
#ElseIf VBA8 Then
DetectOfficeVbaVersion = 8
#ElseIf VBA7 Then
DetectOfficeVbaVersion = 7
#ElseIf VBA6 Then
DetectOfficeVbaVersion = 6
#ElseIf VBA5 Then
DetectOfficeVbaVersion = 5
#ElseIf VBA4 Then
DetectOfficeVbaVersion = 4
#ElseIf VBA3 Then
DetectOfficeVbaVersion = 3
#ElseIf VBA2 Then
DetectOfficeVbaVersion = 2
#ElseIf VBA1 Then
DetectOfficeVbaVersion = 1
#Else
DetectOfficeVbaVersion = 0
#End If
End Function
Public Function DetectOfficePlatformVersion() As OfficePlatformVersion
#If Win64 Then
DetectOfficePlatformVersion = OfficePlatformVersion.Office64
#Else
DetectOfficePlatformVersion = OfficePlatformVersion.Office32
#End If
End Function
Comment by: Yvette (24-10-2011 11:20:58)
Please also email the code you created for working with Office 2007 (32 bit), Office 2010 (32 bit) and Office 2010 (64 bit). I have the exact same scenario
Comment by: Rx_ (24-10-2011 11:39:14)
The last DLL error is 87
It It consistantlly works on XP Access 2007 but not on Windows 7 Access 2010.
Comment by: BERNARDO FIAUX (25-10-2011 17:48:55)
Declare Function impliedBS Lib "c:\dll\option.dll" (ByVal flag As Double, ByVal prazo As Double, ByVal spot As Double, ByVal strike As Double, ByVal taxa As Double, ByVal mercado As Double, ByVal dividend As Double) As double
i tried to add the ptrsafe, like this:
Declare PtrSafe Function impliedBS Lib "c:\dll\option.dll" (ByVal flag As Double, ByVal prazo As Double, ByVal spot As Double, ByVal strike As Double, ByVal taxa As Double, ByVal mercado As Double, ByVal dividend As Double) As Long
but the function is still not working, im wondering why...any idea?
tks
Comment by: Jan Karel Pieterse (26-10-2011 02:59:52)
I advised Ger to replace all LongLong's with LongPtr. Have not heard from him whether that was sufficient.
Comment by: Jan Karel Pieterse (26-10-2011 03:01:46)
I'm sorry, but I don't appear to have that dll, so it is not possible for me to answer your question!
NB: if you are on Office 64 bit and the dll is a 32 bit dll, then it will never work.
Comment by: NEX-5 (11-11-2011 18:56:26)
Comment by: @Alex (20-11-2011 10:57:47)
@Alex
Comment by: enzo (21-11-2011 04:16:47)
here a sample already modified for 64 bit but crash al line:
CC.lpCustColors = StrConv(aCustomColors, vbUnicode)
(Version 32 bit works properly)
*** ERROR: Runtime 13 Conversion type error
#If VBA7 Then
Dim lReturn As LongLong
Dim aCustomColors(0 To 16 * 4 - 1) As Long
Dim i As Integer
Dim lpCC As LongPtr
For i = LBound(aCustomColors) To UBound(aCustomColors)
aCustomColors(i) = 0
Next i
lpCC = StrConv(aCustomColors, vbUnicode)
Dim CC As CHOOSECOLOR
CC.lStructSize = CLng(Len(CC))
CC.hWndOwner = Application.hwnd
CC.hInstance = CLng(0)
CC.lpCustColors = StrConv(aCustomColors, vbUnicode)
CC.flags = CLng(0)
lReturn = ChooseColor(CC)
If lReturn <> 0 Then
Me.Caption = "RGB Value User Chose: "& str$(CC.rgbResult)
Me.idColore = CC.rgbResult
Else
MsgBox "No color selected"
End If
#Else
Dim CC As CHOOSECOLOR
Dim lReturn As Long
Dim aCustomColors(0 To 16 * 4 - 1) As Byte
Dim i As Integer
For i = LBound(aCustomColors) To UBound(aCustomColors)
aCustomColors(i) = 0
Next i
CC.lStructSize = Len(CC)
CC.hWndOwner = Me.hwnd
CC.hInstance = 0
CC.lpCustColors = StrConv(aCustomColors, vbUnicode)
CC.flags = 0
lReturn = ChooseColor(CC)
If lReturn <> 0 Then
Me.Caption = "RGB Value User Chose: " & str$(CC.rgbResult)
Me.idColore = CC.rgbResult
Else
MsgBox "No color selected"
End If
#End If
Comment by: Jan Karel Pieterse (21-11-2011 04:56:46)
Why are you declaring aCustomColors as a Long in the VBA7 case? I'd expect both declares should be of type Byte.
Since I see no differences in the VBA7 case or the Else pare, the entire conditional compilation is not needed?
Comment by: ENZO (21-11-2011 08:35:22)
You are right I've changed type to Long for #VA7
The difference is in function and TYPE CHOOSECOLOR declarations (not wrote above)
here are the two different declarations:
if #Vba7 then
Type CHOOSECOLOR
lStructSize As Long
hWndOwner As LongPtr
hInstance As LongPtr
rgbResult As Long
lpCustColors As LongPtr
flags As Long
lCustData As LongPtr
lpfnHook As LongPtr
lpTemplateName As String
End Type
Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
#else
Type CHOOSECOLOR
lStructSize As Long
hWndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
#end if
Comment by: Jan Karel Pieterse (21-11-2011 10:16:53)
I still think the aCustomeColors array should remain an array of type Byte.
Comment by: enzo (21-11-2011 11:33:06)
CC.lpCustColors = StrConv(aCustomColors, vbUnicode)
Color dialog box don't appears
Comment by: Jan Karel Pieterse (21-11-2011 22:21:44)
Comment by: enzo (9-12-2011 03:49:36)
' 32 BIT VERSION works properly (under 32 bit):
Option Compare Database
Option Explicit
Declare Function ChooseColor Lib "comdlg32.dll" _
Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR_TYPE) _
As Long
Type CHOOSECOLOR_TYPE
lStructSize As Long
hwnd As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
Flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
' ===============================================
Sub TestGetColor()
Dim c
c = GetColor()
If c > 0 Then
MsgBox "SELECTED COLOR: " & c
Else
MsgBox "NO COLOR SELECTED"
End If
End Sub
Function GetColor()
Dim CustomColors() As Byte ' dynamic (resizable) array holds the RGB values
Dim cc As CHOOSECOLOR_TYPE ' structure to pass/receive information
Dim getC As Long ' return value of function
Dim rVal As Long ' return value of function
ReDim CustomColors(0 To 16 * 4 - 1) As Byte ' resize the array
Dim i As Integer ' counter variable
For i = LBound(CustomColors) To UBound(CustomColors)
CustomColors(i) = 0 ' set all custom color choices to black (RGB = 0,0,0)
Next i
cc.hwnd = Application.hWndAccessApp
cc.lpCustColors = StrConv(CustomColors, vbUnicode) ' convert custom color array
cc.Flags = &H80
cc.lStructSize = Len(cc) ' the size of the structure
getC = ChooseColor(cc) ' open the dialog box
If getC <> 0 Then ' if the user successfully chose a color
CustomColors = StrConv(cc.lpCustColors, vbFromUnicode) ' save custom colors
rVal = cc.rgbResult
Else
rVal = -1
End If
GetColor = rVal
End Function
Comment by: Jan Karel Pieterse (9-12-2011 05:18:43)
Thanks.
Comment by: Ali (27-2-2012 05:57:23)
thanks for the solution but could you please take me through it step by step as I am an amateur in VB. My whole office is struggling with the 32bit-64bit compatibility issue.
Regards,
Ali
Comment by: Jan Karel Pieterse (5-3-2012 05:14:12)
If your whole Office needs help with this, perhaps it is a better idea if you get in touch so we can arrange to start a project on this? (see my email address at the bottom of the screen)
Comment by: Macarius (22-3-2012 23:29:37)
Running Windows 7 x64, Office 2007 (32-bit, I believe).
CopyMemory API crashes Excel. Need this ASAP for work. Would most appreciate your thoughts/solutions.
Respectfully,
Macarius
Comment by: Jan Karel Pieterse (23-3-2012 03:58:42)
Look at this page:
http://msdn.microsoft.com/en-us/library/windows/desktop/aa366535(v=vs.85).aspx
It tells us the first two arguments are pointers, so they need to be changes to LongPtr for 64 bit.
Comment by: Theo Vroom (5-5-2012 09:19:35)
I am developping in 32 bit Office 2003 and a number of users run 32 bit office. We now have the first Windows 7 64 bit users and I installed Office 2010 64 bit.
How can I (maybe with a conditional compiler constant, but at least office 2003 does not have eg vba7 or 64bit) continue to develop in 32 bit office, also for use in 64 bit office.
I cannot upgrade to 64 bit myself now.
The easy solution, I believe, would be to install 32 bit office on w7 64 bit, but I like the challenge
Comment by: Jan Karel Pieterse (6-5-2012 11:11:43)
I expect all code that works on 32 bit Office 2010 also to work on 64 bit, except for API declarations. Also, 32 bit ActiveX controls that are not part of Office will not work.
I'd install 32 bit Office and have a virtual machine with 64 bit Office for testing purposes.
Comment by: Natalie (31-5-2012 19:49:56)
Do
PreviousValue=[a1]
CurrentValue = ComPortInput
PreviousValue = CurrentValue
[a1]=PreviousValue
Loop
If you can, please respond with email, thank you.
Comment by: Jan Karel Pieterse (1-6-2012 10:41:51)
Can you try to explain what you are trying to achieve? Where would that value you want to store come from?
Perhaps this page gives you some ideas:
http://www.jkp-ads.com/Articles/DistributeMacro08.asp
Comment by: Natalie (1-6-2012 14:29:21)
Do
PreviousData=[a1]
CurrentData=ComPortInput
DeltaData=CurrentData-PreviousData
PreviousData=CurrentData
[a1]=PreviousData
Loop
I would like to be able to store the PreviousData without having to go to the worksheet cell A1 (or any cell). The data coming in (CurrentData) is from the serial RS232 CommPort. I would like to be able to do this, store the data, perhaps 3,4 times back, i.e.: PreviousData4 without having to store and retrieve from the worksheet. Again, thanks.
Comment by: Jan Karel Pieterse (1-6-2012 14:50:14)
I think I understand now.
Declare your variable at the top of the module:
Dim PreviousValue As Variant 'Or another appropiate type
'All Subs and functions follow below
Comment by: Natalie (1-6-2012 15:10:40)
Comment by: Jan Karel Pieterse (1-6-2012 19:15:14)
Comment by: Natalie (2-6-2012 17:37:35)
Dim Eacc As Integer
Sub RunIt()
DoEvents
RunNow = Now + TimeSerial(0, 0, 1)
Application.OnTime RunNow, "RunIt", , True
HDG = [a1]
Eacc = Eacc + HDG
[b1] = Eacc
DoEvents
End Sub
Comment by: David McIntosh (4-6-2012 16:33:21)
Comment by: Jan Karel Pieterse (4-6-2012 18:15:37)
Well spotted, thank you!
Page updated.
Comment by: David I. McIntosh (4-6-2012 19:32:37)
Comment by: David I. McIntosh (4-6-2012 19:35:34)
http://www.microsoft.com/en-us/download/details.aspx?id=9970
Comment by: David I. McIntosh (4-6-2012 20:54:56)
Thus, the declaration for SendMessage in 64bit should be
Public Declare PtrSafe Function SendMessageA Lib "user32"(ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
and note that is is in fact what is in the Microsoft doc. (SendMessage was, unfortunately, the worst function to pick as an example!!!)
Comment by: Jan Karel Pieterse (5-6-2012 08:44:26)
Thanks for looking through the article and spotting the errors (it is easy to miss an item to convert from Long to LongPtr -or not-), much appreciated!
Comment by: Yves BENOIT (14-6-2012 01:54:53)
is there a way to play sounds in 64 bits VBA, now that the 32 bits calls to Playsound and others are obsolete?
Thank you
Yves
Comment by: Jan Karel Pieterse (14-6-2012 08:19:07)
Does it work if you declare the function like this:
Lib "winmm.dll" _
Alias "sndPlaySoundA" ( _
ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long
Comment by: Banana (28-6-2012 00:14:22)
http://www.utteraccess.com/wiki/index.php/Category:API
Comment by: Jan Karel Pieterse (28-6-2012 11:08:22)
Thanks!
Comment by: Peter van Loosbroek (28-6-2012 14:40:42)
I used the GetOpenFileName methode in 32 bit verions of MS Office. Working well. Now I converted to 64 bit and use it in MS Office 64 bit, but the dialog box won't open. I don't know what I am doing wrong. I've rearched the web but can't solve the problem. Please can you help me? I would be very greatfull!
Thanks, Peter (Netherlands)
Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public 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 Long
lpfnHook As LongPtr '
lpTemplateName As String
End Type
Public Function TestGetFile(strTitle As String) As String
Dim OpenFile As OPENFILENAME
Dim lReturn As LongPtr
Dim sFilter As String
OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = 0
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = "C:\"
OpenFile.lpstrTitle = strTitle
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
TestGetFile = ""
Else
TestGetFile = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
End If
End Function
Comment by: Jan Karel Pieterse (29-6-2012 11:39:35)
Just curious: why are you using the API function to start with, there's an Application.GetOpenFileName available too?
Comment by: Peter van Loosbroek (29-6-2012 12:02:47)
The code I used in a standard module in MS Access. In a 32 bit version it works well (of course without using PtrSafe and LongPtr). The function TestGetFile returns the filename. You can test is in the debug window.
I also learned that the VB function Len (in TestGetFile) should be LenB in a 64 bit version.
I hope you can help me (and more people because everyon can use this function).
Regards, Peter, The Netherlands
Comment by: Jan Karel Pieterse (29-6-2012 14:47:51)
Odd that it does not work. I have no idea why though. Perhaps looking through the MSDN documentation fo the function gives you pointers?
http://msdn.microsoft.com/en-us/library/windows/desktop/ms646927(v=vs.85).aspx
Comment by: Jon Peltier (3-7-2012 18:28:57)
#If VBA7 And Win64 Then
Comment by: Jan Karel Pieterse (3-7-2012 21:47:56)
True, but as far as I know, in almost all cases the VBA7 test suffices, unless there are specific reasons to test for bitness.
Comment by: technolust (11-7-2012 21:35:30)
Comment by: Sisyphus (21-8-2012 20:21:11)
http://www.microsoft.com/en-us/download/details.aspx?id=9970
The site acts like it were supply an executable file. However, if you acceded to all requests, all you get are 3 very useful documents.
Comment by: MK (21-9-2012 11:11:50)
Comment by: Dharmendra (8-10-2012 18:54:16)
We have Excel spredsheet with VBA code to get data from user to our system using CyberLynx approach. Here are lines that declare the said object..
Dim cyberlynxobj
Set cyberlynxobj = New CyberLynx
It is working just fine on Windows 32 or Window 64 with Office 32 bit version but we have new team using Window 64 and Office 64bit getting following error in the above line as:
"License information for this omponent not found. You do not have an appropriate license to use this functionality in the design environment"
Any suggestion/help? Thanks in advance.
Comment by: Jan Karel Pieterse (9-10-2012 10:24:50)
This means that the Cyberlynx system you refer to is not a 64 bit system and cannot be called from 64 bit Excel.
You must contact the vendor and ask if they have a 64 bit COM enabled version of the system that can be called from Excel VBA.
Comment by: Gyula (5-11-2012 03:08:52)
or do I need to use something like:
Thanks a lot!
Comment by: Jan Karel PIeterse (5-11-2012 08:44:32)
I suggest you just try!
VBA seems to allow it, but I don't know if it'll work in the code at runtime?
Comment by: Peter Sierek (4-12-2012 05:15:03)
maybe I will not get an answer from you. I want to query in Excel VBA, which has bit version of the computer. How does this line are for 64-bit?
Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef K As Long, ByVal Rola As Long) As Long
In the hope of getting an answer, I remain, with
friendly greetings
Peter Sierek
Comment by: Jan Karel Pieterse (4-12-2012 08:51:01)
The bitness of windows can be detected like so (taken from http://www.freevbcode.com/ShowCode.asp?ID=9043 and adjusted to cater for 64 bit Office):
Part 1, declarations:
#If VBA7 Then
Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As LongPtr, _
ByVal lpProcName As String) As LongPtr
Private Declare Function GetModuleHandle Lib "kernel32" _
Alias "GetModuleHandleA" _
(ByVal lpModuleName As String) As LongPtr
Private Declare Function GetCurrentProcess Lib "kernel32" _
() As LongPtr
Private Declare Function IsWow64Process Lib "kernel32" _
(ByVal hProc As LongPtr, _
bWow64Process As Boolean) As Long
#Else
Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, _
ByVal lpProcName As String) As Long
Private Declare Function GetModuleHandle Lib "kernel32" _
Alias "GetModuleHandleA" _
(ByVal lpModuleName As String) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" _
() As Long
Private Declare Function IsWow64Process Lib "kernel32" _
(ByVal hProc As Long, _
bWow64Process As Boolean) As Long
#End If
Comment by: Jan Karel Pieterse (4-12-2012 08:51:29)
Part 2, Function:
Dim handle As Long, bolFunc As Boolean
' Assume initially that this is not a Wow64 process
bolFunc = False
' Now check to see if IsWow64Process function exists
handle = GetProcAddress(GetModuleHandle("kernel32"), _
"IsWow64Process")
If handle > 0 Then ' IsWow64Process function exists
' Now use the function to determine if
' we are running under Wow64
IsWow64Process GetCurrentProcess(), bolFunc
End If
Is64bit = bolFunc
End Function
Comment by: dave (29-12-2012 06:58:35)
below is the link to the webpage extension i want to use that requires my excel file to request the appropriate license key through an API from each end user's computer to prevent unauthorized distribution of the file. how do i do this and how do i connect to this api??????
http://wcdocs.woothemes.com/user-guide/extensions/software-add-on/
thanks for your help!
PS. please keep in mind that my file has no macros and what i am trying to protect is the formulas i have built and the data interface i have designed to collect and analyze the data each user would be generating. i built a 40mb file with nothing but formulas and tables, etc....
Comment by: Jan Karel Pieterse (29-12-2012 16:51:33)
"Connecting" to this API will require VBA programming.
Unfortunately, the content of Excel workbooks is poorly protected. Anyone can get quick access to your model by running just one simple macro that removes all passwords.
The only way might be to create an on-line version of your model, but that likely requires:
1. An Office 365 subscription (not sure if that suffices)
2. A (possibly drastic) redesign of your model to make it work on-line using the Excel web app.
Comment by: Patrick Headley (31-1-2013 19:39:40)
Comment by: Jan Karel Pieterse (1-2-2013 15:08:15)
What code does your Excel fail on?
Comment by: fabrice CONSTANS (4-2-2013 16:42:04)
I have a heterogeneous Park: windows xp, vista, 7 and 8 in 32 or 64 bit Excel 2003 to 2010 in 32 or 64 bit.
What should i use as a compile-time directive? Win64 and vba7, both?
Should I deliver for 2003 to 2007 and 2010 32/64 versions?
My code is :
#If Win64 Then
Private Type structHH_FTS_QUERY
cbStruct As Long
fUniCodeStrings As Long
pszSearchQuery As String
iProximity As Long
fStemmedSearch As Long
fTitleOnly As Long
fExecute As Long
pszWindow As String
End Type
Private Declare PtrSafe Function HtmlHelp Lib "hhctrl.ocx" Alias "HtmlHelpA" _
(ByVal hwndCaller As LongPtr, _
ByVal pszFile As String, _
ByVal uCommand As HH_COMMAND, _
dwData As Any) As LongPtr
#Else
Private Type structHH_FTS_QUERY
cbStruct As Long
fUniCodeStrings As Long
pszSearchQuery As String
iProximity As Long
fStemmedSearch As Long
fTitleOnly As Long
fExecute As Long
pszWindow As String
End Type
Private Declare Function HtmlHelp Lib "hhctrl.ocx" Alias "HtmlHelpA" _
(ByVal hwndCaller As Long, _
ByVal pszFile As String, _
ByVal uCommand As HH_COMMAND, _
dwData As Any) As Long
#End If
Public Sub Show(NewFile As String, Optional WindowPane As String, Optional ContextID)
Dim Fichier As String
Fichier = NewFile
...
#If Win64 Then
Call HtmlHelp(0, Fichier, HH_HELP_CONTEXT, ByVal CLng(ContextID))
#Else
Call HtmlHelp(0, Fichier, HH_HELP_CONTEXT, ByVal CLngLng(ContextID))
#End If
End If
End Sub
Thank you.
Fabrice CONSTANS MVP
Comment by: Jan Karel Pieterse (5-2-2013 17:37:43)
As far as I know, VBA7 suffices UNLESS there is a specific API which behaves different on a Win64 machine then on a Win32 machine (e.g. is in a different dll or has a difference in arguments). The ones listed here seem to work just fine with just VBA7.
Comment by: Mireille DOUGUET (11-3-2013 12:13:09)
I am from France, and your article was very usefull for me.
But I did'nt success in declaring the function GetPrivateProfileString in my vba code (access 2010 module under Windows Server 2008)...
I couldn't declare the return value to LongPtr because it made a program crash.
When declaring it to Long, with the key PtrSafe, then I could have the return value (the number of characters read)
But I could'nt retrieve the string read...
Here is my code (not crashing, but not working...) :
Thank you for your feedback.
Best regards
M. DOUGUET
'Read
Private Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long
Function Startup()
...
Dim iResult As LongPtr
iResult = GetPrivateProfileString("ETAT", "NOM_ETAT", "", sParamNomEtat, 255, "D:\BTIA_CONF\LanceAccess.INI")
....
Comment by: Jan Karel Pieterse (11-3-2013 15:32:52)
The reason is that the GetPrivateProfileString function returns a Long, not a LongPtr.
So your Dim statement must indeed declare as Long:
Comment by: Zac (12-3-2013 16:03:28)
I had used the PtrSafe expression below yesterday with great results, but today it no longer works... I am trying to get an calculation box to work. It is labeled as Text227. Yesterday when I used the PtrSafe expression I placed it on the very top line, for example Option PtrSafe Compare Database.
Any ideas?
Thank you for your help!
Option Compare Database
Option Explicit
' Copyright Lebans Holdings 1999 Ltd.
' Color only the Active/Current TAB and
' not the background of the Tab control
' Var of type Tab class
Private TB As clsTabsCurrentPage
' Temp var for the Class
Dim blRet As Boolean
Dim lngRet As Long
Private Sub Form_Load()
DoCmd.MoveSize 0, 0, 6650, 5200
' Create an instance of our FormatByCriteria class
Set TB = New clsTabsCurrentPage
' You MUST set the CriteriaControl prop
' Set the first TAB Page as the current page
Me.TabCtl.Value = 0
TB.TabControl = Me.TabCtl
' You MUST set the BackGround control
' used to display the current pages background color
TB.BGControl = Me.RecBG
' Parent Form
TB.TabForm = Me
' Set the desired Rotation amount
' For this class it should remain at Zero as
' the class only renders the Text when it is colored.
TB.RotateDegree = 0
' Create the Tabs
' For this sample we only want the Current TAB itself colored
' not the background of the TAB control.
TB.ColorTabsOnly = True
TB.MakeTabsCurrentPage Me.TabCtl.Value
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set TB = Nothing
End Sub
Private Sub Text227_BeforeUpdate(Cancel As Integer)
End Sub
Comment by: Jan Karel Pieterse (12-3-2013 16:27:47)
I see no API declarations in the code you posted?
Comment by: Mireille DOUGUET (13-3-2013 11:27:19)
But the problem is that I can retrieve the number of bytes, ok, but I can't retrieve the string that the GetPrivateProfileString must return to me...
Perhaps the definition of the lpReturnedString parameter, or the way it is passed to the function...
Best regards
M. DOUGUET
Comment by: Jan Karel Pieterse (13-3-2013 16:32:29)
According to the microsoft documentation, this is the correct 64 bit declaration:
Comment by: ChanthornLaiy (1-4-2013 18:06:13)
Comment by: Neil Rogers (18-4-2013 02:45:15)
Comment by: Jan Karel Pieterse (18-4-2013 13:27:51)
You're right of course.
I started building this list and adding Functions as I happen to have the need form them in tools that require porting to 64 bit Office.
As it happens I have not encountered the need to add Sub declarations yet.
As soon as I encounter one (or if you send me some) I'll add them.
Comment by: mic (10-5-2013 16:51:54)
Comment by: Jan Karel Pieterse (10-5-2013 17:17:41)
Basically, as long as you use the method shown here, you should be fine for older Office versions.
Of course you will have to test your code on all Office versions that it will be used.
Comment by: wwwilli (15-5-2013 12:10:26)
Comment by: Jan Karel Pieterse (15-5-2013 12:44:34)
That is a very concise question :-). Care to elaborate a bit?
Comment by: wwwilli (15-5-2013 13:05:59)
Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long _
, ByVal lParam As Long) As Long
?
Comment by: Jan Karel Pieterse (15-5-2013 13:55:54)
The correct 64 bit declaration is:
Comment by: wwwilli (17-5-2013 21:17:04)
And bedankt for the whole list.
Comment by: Swap (24-5-2013 14:35:56)
I have written code in vba to open regisry and get handel of some application, it is working fine on XP, office2003 but on windows7(64 bit), office 2010(32bit not sure) code is not working for, RegOpenKeyEx command. Here is the code.
Please help.
Public Declare Function RegCloseKey Lib "ADVAPI32" (ByVal hKey&) As Long
Public Declare Function RegOpenKeyEx Lib "ADVAPI32" Alias "RegOpenKeyExA" (ByVal hKey&, ByVal lpSubKey$, ByVal ulOptions&, ByVal samDesired&, phkResult&) As Long
Public Declare Function RegQueryValueEx Lib "ADVAPI32" Alias "RegQueryValueExA" (ByVal hKey&, ByVal lpValueName$, ByVal lpReserved&, ByVal lpType&, ByVal lpData$, lpcbData&) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Const HKEY_CLASSES_ROOT As Long = &H80000000
Public Const HKEY_CURRENT_USER As Long = &H80000001
Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
Public Const HKEY_USERS As Long = &H80000003
Public Const ERROR_SUCCESS As Long = &H0
Global Const SYNCHRONIZE As Long = &H100000
Global Const INFINITE As Long = &HFFFFFFFF
'define
Public Const MAX_PATH As Long = 260
Public Const FILE_TYPE_XLS As Long = 0
Public Const FILE_TYPE_CSV As Long = 1
Sub check()
Ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\XYZ_App", 0, 1, hKey)
Ret = RegQueryValueEx(hKey, "InstallPath", 0, 0, RegValue, MAX_PATH)
End sub
Comment by: Jan Karel Pieterse (24-5-2013 14:51:57)
Can you perhaps give a more complete example with variable content in place that does work on XP/2003 and returns a proper value? Otherwise this is a bit hard to test.
Comment by: Anon (12-6-2013 05:00:47)
Private Declare Function SendDlgItemMessage _
Lib "user32" Alias "SendDlgItemMessageA" ( _
ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
Comment by: Jan Karel Pieterse (12-6-2013 08:05:38)
From the download link shown at the top of this article:
http://www.microsoft.com/downloads/en/confirmation.aspx?FamilyID=035b72a5-eef9-4baf-8dbc-63fbd2dd982b&displaylang=en
Comment by: Anon (13-6-2013 05:09:23)
I tried the MS download but I get a "no result" when searching for this function in VBA help after installing?
I am now looking for URLDownloadToFile. I can not find that by searching the help either.
Comment by: Jan Karel Pieterse (13-6-2013 08:47:56)
It is not obvious, but the API declarations are in the txt file.
Comment by: Emiel Nijhuis (20-6-2013 21:31:15)
When looking for 64 bit API calls to manipulate the clipboard I came across this sample:
https://korpling.german.hu-berlin.de/p/projects/excelfalkoplugin/repository/revisions/321/entry/Components/mdlApi.bas
I tested the sample and it functions without error.
It is a 'translation' of the following MSDN example:
http://msdn.microsoft.com/en-us/library/office/ff192913.aspx
Might be useful for your list,
Regards,
Emiel Nijhuis
Comment by: Jan Karel Pieterse (21-6-2013 12:01:24)
Thanks!
Comment by: Mathys Walma (23-7-2013 01:04:30)
Declare PtrSafe Function SetupComm Lib "kernel32" Alias "SetupComm" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
hFile is LongPtr in a lot of other functions.
Comment by: George Marcovits (3-8-2013 09:20:22)
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Public TimerID As Long
Public TimerSeconds As Single
Sub StartTimer30T()
Windows("Test.xls").Activate
Sheets("First").Select
Application.Run "Test.xls!AtTheStart"
TimerSeconds = 30
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub
Sub EndTimer30T()
On Error Resume Next
Sheets("First").Select
Range("A1").Select
KillTimer 0&, TimerID
End Sub
I am planning to use them on a computer with Windows 7 and Office 2013 all 64 bit. Will the above codes work and if not any directions on what to change will be highly appreciated.
Thank you very much in advance,
George
Comment by: George Marcovits (3-8-2013 09:24:22)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_SYSMENU = &H80000
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
Private Enum ESetWindowPosStyles
SWP_SHOWWINDOW = &H40
SWP_HIDEWINDOW = &H80
SWP_FRAMECHANGED = &H20
SWP_NOACTIVATE = &H10
SWP_NOCOPYBITS = &H100
SWP_NOMOVE = &H2
SWP_NOOWNERZORDER = &H200
SWP_NOREDRAW = &H8
SWP_NOREPOSITION = SWP_NOOWNERZORDER
SWP_NOSIZE = &H1
SWP_NOZORDER = &H4
SWP_DRAWFRAME = SWP_FRAMECHANGED
HWND_NOTOPMOST = -2
End Enum
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Comment by: George Marcovits (3-8-2013 09:24:53)
Dim lStyle As Long
Dim tRect As RECT
Dim sWndTitle As String
Dim xlhnd
sWndTitle = "Microsoft Excel - " & ActiveWindow.Caption
xlhnd = FindWindow(vbNullString, sWndTitle)
GetWindowRect xlhnd, tRect
If Not bShow Then
lStyle = GetWindowLong(xlhnd, GWL_STYLE)
lStyle = lStyle And Not WS_SYSMENU
lStyle = lStyle And Not WS_MAXIMIZEBOX
lStyle = lStyle And Not WS_MINIMIZEBOX
lStyle = lStyle And Not WS_CAPTION
Else
lStyle = GetWindowLong(xlhnd, GWL_STYLE)
lStyle = lStyle Or WS_SYSMENU
lStyle = lStyle Or WS_MAXIMIZEBOX
lStyle = lStyle Or WS_MINIMIZEBOX
lStyle = lStyle Or WS_CAPTION
End If
SetWindowLong xlhnd, GWL_STYLE, lStyle
SetWindowPos xlhnd, 0, tRect.Left, tRect.Top, tRect.Right - tRect.Left, tRect.Bottom - tRect.Top, SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED
End Sub