I'm trying the access files in the clipboard using VBA in PowerPoint, but DragQueryFile always returns 0.
Here my code snipped
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal uFormat As Long) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal uFormat As Long) As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" ( ByVal hwnd As Long) As Long
Private Declare PtrSafe Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" ( ByVal HDROP As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Const CF_HDROP As Long = 15
Private Sub test_clipboard()
Dim nHandle As Long
If IsClipboardFormatAvailable(CF_HDROP) > 0 Then
If OpenClipboard(0) <> 0 Then
nHandle = GetClipboardData(CF_HDROP)
If nHandle <> 0 Then
' Query number of files in clipboard -> returns always 0
Debug.Print CStr(DragQueryFile(nHandle, GetNumOfFiles, vbNullString, 0))
End If
CloseClipboard
End If
End If
End sub
I'm on Windows 10 and Office 2013.
There is a similar post for C# (DragQueryFile returns 0 when I try to get file count?), but I'm calling OpenClipboard an CloseClipboard already.
Any help is appreciated.
I got it working with tmp_hallenser's comment, but thought it would would be better to lay it out more clearly.
One should change this two function definitions:
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal uFormat As Long) As LongPtr
Private Declare PtrSafe Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" ( ByVal HDROP As LongPtr, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
That is necessary because HDROP is a memory address and as such is going to be a different size according to the system.
The type LongPtr will always be the appropriate size.
Related
I like to copy an excel file to clipboard by VBA, so that I can paste the excel file to some other places. I found the below VBA codes on the internet. But the codes seems not working, the Excel file (contain the VBA code) shut down automatically after running the codes. Can some one advise? Thanks.
Option Explicit
' Required data structures
Private Type POINTAPI
x As Long
y As Long
End Type
' Clipboard Manager Functions
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
' Other required Win32 APIs
Private Declare PtrSafe Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare PtrSafe Function DragQueryPoint Lib "shell32.dll" (ByVal hDrop As Long, lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
' Predefined Clipboard Formats
Private Const CF_TEXT = 1
Private Const CF_BITMAP = 2
Private Const CF_METAFILEPICT = 3
Private Const CF_SYLK = 4
Private Const CF_DIF = 5
Private Const CF_TIFF = 6
Private Const CF_OEMTEXT = 7
Private Const CF_DIB = 8
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_RIFF = 11
Private Const CF_WAVE = 12
Private Const CF_UNICODETEXT = 13
Private Const CF_ENHMETAFILE = 14
Private Const CF_HDROP = 15
Private Const CF_LOCALE = 16
Private Const CF_MAX = 17
' New shell-oriented clipboard formats
Private Const CFSTR_SHELLIDLIST As String = "Shell IDList Array"
Private Const CFSTR_SHELLIDLISTOFFSET As String = "Shell Object Offsets"
Private Const CFSTR_NETRESOURCES As String = "Net Resource"
Private Const CFSTR_FILEDESCRIPTOR As String = "FileGroupDescriptor"
Private Const CFSTR_FILECONTENTS As String = "FileContents"
Private Const CFSTR_FILENAME As String = "FileName"
Private Const CFSTR_PRINTERGROUP As String = "PrinterFriendlyName"
Private Const CFSTR_FILENAMEMAP As String = "FileNameMap"
' Global Memory Flags
Private Const GMEM_FIXED = &H0
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_NOCOMPACT = &H10
Private Const GMEM_NODISCARD = &H20
Private Const GMEM_ZEROINIT = &H40
Private Const GMEM_MODIFY = &H80
Private Const GMEM_DISCARDABLE = &H100
Private Const GMEM_NOT_BANKED = &H1000
Private Const GMEM_SHARE = &H2000
Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_NOTIFY = &H4000
Private Const GMEM_LOWER = GMEM_NOT_BANKED
Private Const GMEM_VALID_FLAGS = &H7F72
Private Const GMEM_INVALID_HANDLE = &H8000
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
Private Type DROPFILES
pFiles As Long
pt As POINTAPI
fNC As Long
fWide As Long
End Type
Public Function ClipboardCopyFiles(Files() As String) As Boolean
Dim data As String
Dim df As DROPFILES
Dim hGlobal As Long
Dim lpGlobal As Long
Dim i As Long
' Open and clear existing crud off clipboard.
If OpenClipboard(0&) Then
Call EmptyClipboard
' Build double-null terminated list of files.
For i = LBound(Files) To UBound(Files)
data = data & Files(i) & vbNullChar
Next
data = data & vbNullChar
' Allocate and get pointer to global memory,
' then copy file list to it.
hGlobal = GlobalAlloc(GHND, Len(df) + Len(data))
If hGlobal Then
lpGlobal = GlobalLock(hGlobal)
' Build DROPFILES structure in global memory.
df.pFiles = Len(df)
Call CopyMem(ByVal lpGlobal, df, Len(df))
Call CopyMem(ByVal (lpGlobal + Len(df)), ByVal data, Len(data))
Call GlobalUnlock(hGlobal)
' Copy data to clipboard, and return success.
If SetClipboardData(CF_HDROP, hGlobal) Then
ClipboardCopyFiles = True
End If
End If
' Clean up
Call CloseClipboard
End If
End Function
Public Function ClipboardPasteFiles(Files() As String) As Long
Dim hDrop As Long
Dim nFiles As Long
Dim i As Long
Dim desc As String
Dim filename As String
Dim pt As POINTAPI
Const MAX_PATH As Long = 260
' Insure desired format is there, and open clipboard.
If IsClipboardFormatAvailable(CF_HDROP) Then
If OpenClipboard(0&) Then
' Get handle to Dropped Filelist data, and number of files.
hDrop = GetClipboardData(CF_HDROP)
nFiles = DragQueryFile(hDrop, -1&, "", 0)
' Allocate space for return and working variables.
ReDim Files(0 To nFiles - 1) As String
filename = Space(MAX_PATH)
' Retrieve each filename in Dropped Filelist.
For i = 0 To nFiles - 1
Call DragQueryFile(hDrop, i, filename, Len(filename))
Files(i) = TrimNull(filename)
Next
' Clean up
Call CloseClipboard
End If
' Assign return value equal to number of files dropped.
ClipboardPasteFiles = nFiles
End If
End Function
Private Function TrimNull(ByVal sTmp As String) As String
Dim nNul As Long
'
' Truncate input sTmpg at first Null.
' If no Nulls, perform ordinary Trim.
'
nNul = InStr(sTmp, vbNullChar)
Select Case nNul
Case Is > 1
TrimNull = Left(sTmp, nNul - 1)
Case 1
TrimNull = ""
Case 0
TrimNull = Trim(sTmp)
End Select
Sub maaa()
'i = "c:\" & ActiveDocument.Name
'ActiveDocument.SaveAs i
Dim afile(0) As String
afile(0) = "c:\070206.excel" 'The file actually exists
MsgBox ClipboardCopyFiles(afile)
End Sub
Here is how you would do a proper Win API declaration
#If VBA7 Then
' Clipboard Manager Functions
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
' Other required Win32 APIs
Private Declare PtrSafe Function DragQueryFile Lib "shell32.dll" (ByVal HDROP As LongPtr, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare PtrSafe Function DragQueryPoint Lib "shell32.dll" (ByVal HDROP As LongPtr, lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
' Clipboard Manager Functions
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
' Other required Win32 APIs
Private Declare Function DragQueryFile Lib "shell32.dll" (ByVal HDROP As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare Function DragQueryPoint Lib "shell32.dll" (ByVal HDROP As Long, lpPoint As POINTAPI) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If
Keep in mind that you would need for example
#If VBA7 Then
Dim hGlobal As LongPtr
Dim lpGlobal As LongPtr
#Else
Dim hGlobal As Long
Dim lpGlobal As Long
#End If
whenever you declare variables (that WIN API 'uses') in your functions/subs. This is needed just so it works on versions prior to MS Office 2010.
If you are sure that your code will be used on version 2010+, you can drop everything after #Else or drop conditional compilation altogether and just use declarations inside VBA7. LongPtr is 32/64 bit.
In your code you need to End Function TrimNull as well.
Also if you plan on using WIN API extensively you should check https://www.microsoft.com/en-us/download/details.aspx?id=9970
I haven't learned yet how to correctly convert the Windows API functions to be used on Excel VBA. If I can't find it online and it isn't something easy like SwapMouseButton or SetDoubleClickTime I just get stuck on getting it to work.
Can I get some help fixing my call of the GetMouseMovePointsEx function and maybe tips to understand better how to do it for other complex function?
Here's what I have in a module:
Private Declare Function SwapMouseButton Lib "user32" (ByVal fSwap As Boolean) As Boolean
Private Declare Function SetDoubleClickTime Lib "user32" (ByVal uInterval As Integer) As Boolean
Private Type MOUSEMOVEPOINT
x As Integer
y As Integer
time As Long
dwExtraInfo As Long
End Type
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetActiveWindow Lib "user32" () As Long
'Private Declare Function WindowProc Lib "user32" (ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_MOUSEDOWN = &H200
Private Declare Function GetMouseMovePointsEx Lib "user32" (ByVal cbSize As Integer, ByRef lppt As MOUSEMOVEPOINT, ByRef lpptBuf() As MOUSEMOVEPOINT, ByVal nBufPoints As Integer, ByVal resolution As Long) As Integer
Private Sub Test1()
SwapMouseButton False 'True|False
End Sub
Private Sub Test2()
SetDoubleClickTime 0 '0=default(500), 48~=fastest I could get, >5000=5000
End Sub
Private Sub Test3()
Dim hwnd As Long, mmp As MOUSEMOVEPOINT, mmpBuf(64) As MOUSEMOVEPOINT, returnedValue As Integer
Sleep 1000
hwnd = GetActiveWindow()
'WindowProc hwnd, WS_MOUSEMOVE, WS_MOUSEMOVE, WS_MOUSEMOVE
mmp.x = 600
mmp.y = 300
mmp.time = 200
returnedValue = GetMouseMovePointsEx(Len(mmp), mmp, mmpBuf, 1000, 1)
If returnedValue = -1 Then
Debug.Print "Error"
Else
Debug.Print mmpBuf(0).x
Debug.Print mmpBuf(0).y
End If
End Sub
I have found a previous thread that shows how to get all open windows and their names using C# : get the titles of all open windows
However, I need to do this in VBA: does anyone know if that's possible?
Thank you so much.
Best regards
Here's a scrape from this microsoft answer by Andreas Killer that uses EnumWindows() which did the trick for me:
Option Explicit
#If Win64 Then
Private Declare PtrSafe Function GetWindowTextLengthA Lib "user32" ( _
ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function EnumWindows Lib "user32" ( _
ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
#Else
Private Declare Function GetWindowTextLengthA Lib "user32" ( _
ByVal hWnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function EnumWindows Lib "user32" ( _
ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
#End If
Private Sub debug_ListWindows()
ListWindows
End Sub
Private Function ListWindows()
EnumWindows AddressOf EnumFindWindowLikeProc, 0
End Function
#If Win64 Then
Private Function EnumFindWindowLikeProc(ByVal hWnd As LongPtr, ByVal lParam As Long) As Long
#Else
Private Function EnumFindWindowLikeProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
#End If
If IsWindowVisible(hWnd) Then
If Len(Trim(WindowTitle(hWnd))) > 0 Then
Debug.Print WindowTitle(hWnd)
End If
End If
EnumFindWindowLikeProc = 1
End Function
#If Win64 Then
Private Function IsWindowVisible(ByVal hWnd As LongPtr) As Boolean
#Else
Private Function IsWindowVisible(ByVal hWnd As Long) As Boolean
#End If
Const GWL_STYLE = -16 'Sets a new window style
Const WS_VISIBLE = &H10000000 'The window is initially visible
Dim lngStyle As Long
lngStyle = GetWindowLong(hWnd, GWL_STYLE)
IsWindowVisible = ((lngStyle And WS_VISIBLE) = WS_VISIBLE)
End Function
#If Win64 Then
Property Get WindowTitle(ByVal hWnd As LongPtr) As String
#Else
Property Get WindowTitle(ByVal hWnd As Long) As String
#End If
Dim Contents As String, i As Long
Contents = Space$(GetWindowTextLengthA(hWnd) + 1)
i = GetWindowText(hWnd, Contents, Len(Contents))
WindowTitle = Left$(Contents, i)
End Property
and here is a pretty truncated version that loops using GetWindow() which should work on sufficiently new office installations:
Option Explicit
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowTextLengthA Lib "user32" ( _
ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
ByVal hWnd As LongPtr, ByVal lpString As String, _
ByVal cch As LongPtr) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" ( _
ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
Private Sub debug_ListWindows()
ListWindows
End Sub
Private Function ListWindows()
Const GWL_STYLE = -16 'Sets a new window style
Const WS_VISIBLE = &H10000000 'The window is initially visible
Const GW_HWNDNEXT = 2 'The retrieved handle identifies the window below the specified window in the Z order
Dim hWnd As LongPtr
hWnd = FindWindow(vbNullString, vbNullString)
While hWnd
Dim sTitle As String
sTitle = Space$(GetWindowTextLengthA(hWnd) + 1)
sTitle = Left$(sTitle, GetWindowText(hWnd, sTitle, Len(sTitle)))
If (GetWindowLong(hWnd, GWL_STYLE) And WS_VISIBLE) = WS_VISIBLE Then 'only list visible windows
If Len(Trim(sTitle)) > 0 Then 'ignore blank window titles
Debug.Print sTitle
End If
End If
hWnd = GetWindow(hWnd, GW_HWNDNEXT)
Wend
End Function
Sub ListWindows()
Dim wn As Excel.Window
For Each wn In Application.Windows
Debug.Print wn.Caption
Next wn
End Sub
if you wanted to activate any of them simply use:
wn.Activate
I am working on converting some very old VBA code to run on AutoCAD 2014. I have so far converted everything but there is an issue with the forms (they are modeless and require an activation callback to modify the window propertis). The following is the VBA6 source code:
IN THE FORM:
Private Sub UserForm_Activate()
#If ACAD2000 = 0 Then
If Not bPopup Then
Call EnumWindows(AddressOf EnumWindowsProc, vbNull)
Call SubClass
bPopup = True
End If
#End If
End Sub
MODULE (named modModeLessFormFocus):
Option Explicit
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private ThisHwnd As Long
Public Const GWL_STYLE = -16
Public Const WS_POPUP = &H80000000
Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Integer
Dim title As String * 32
Call GetWindowText(hwnd, ByVal title, 32)
If InStr(title, "About") Then
ThisHwnd = hwnd
EnumWindowsProc = False
ElseIf InStr(title, "Preferences") Then
ThisHwnd = hwnd
EnumWindowsProc = False
ElseIf InStr(title, "Display Block Attributes") Then
ThisHwnd = hwnd
EnumWindowsProc = False
Else
EnumWindowsProc = True
End If
End Function
Public Function SubClass() As Long
Dim Flags As Long
Flags = GetWindowLong(ThisHwnd, GWL_STYLE)
Flags = Flags Xor WS_POPUP
SetWindowLong ThisHwnd, GWL_STYLE, Flags
End Function
The error I get when running is a "Type Mismatch" in UserForm_Activate on 'AddressOf EnumWindowsProc.' I have tried to convert it to 64bit using PtrSafe and PtrLong but inevitably it fails and the program crashes.
If anyone is smart enough to convert this or point me in the right direction I would be very appreciative.
Thanks
I found the API for 64-bit VBA7 in http://www.jkp-ads.com/articles/apideclarations.asp
#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
Private Declare PtrSafe Function GetWindowText Lib "USER32" Alias "GetWindowTextA" _
(ByVal hWnd As LongPtr, ByVal lpString As String, _
ByVal cch As LongPtr) As Long
#Else
Private Declare Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetWindowText Lib "USER32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long
#End If
You can also look at http://msdn.microsoft.com/en-us/library/aa383663(VS.85).aspx for the updated API
I’m compiling my Access database from a 32-bit Office machine running Access 2010. I’m deploying as an .accdr file for use in Access 2010 Runtime. My references are:
VBE7.DLL
MSACC.OLB
stdole2.tlb
ACEDAO.DLL
EXCEL.EXE
msxml6.dll
I will need to deploy to a range of platforms, including 64-bit 2010, 2013 and so on.
I take it there is no problem with most of the references as the deployed system will be using Access 2010 Runtime. However, Excel will give me a problem. I had tried registering the Excel reference (in fact all references, just in case any any other version differed by machine) on the fly, but it seems I can’t register a 64-bit version of Excel from a 32-bit system. Or can I?
Also, would I still need to make changes to API calls (using the PtrSafe keyword) if I’m using Runtime 2010?
Here are some of the API calls I make:
Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll"
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Private Declare Function apiGetLocaleInfo Lib "kernel32"
Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function LoadLibraryRegister Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName$) As Long
Public Declare Function SetDllDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
Private Declare Function GetProcAddressRegister Lib "kernel32" Alias _
"GetProcAddress" (ByVal hModule&, ByVal lpProcName$) As Long
Private Declare Function CreateThreadForRegister Lib "kernel32" Alias "CreateThread" (lpThreadAttributes As Any, ByVal dwStackSize&, ByVal lpStartAddress&, ByVal lpparameter&, ByVal dwCreationFlags&, ThreadID&) As Long
You need to make sure that the code is capable of running on both environments. So you could use as me how has suggested Conditional Compiling.
I normally use all the Library calls in a standard module. You should be able to do it something along the lines of:
#If Win64 = 1 And VBA7 = 1 Then
Declare PtrSafe Function aht_apiGetOpenFileName Lib "comdlg32.dll"
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Private Declare PtrSafe Function apiGetLocaleInfo Lib "kernel32"
Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare PtrSafe Function LoadLibraryRegister Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName$) As Long
Public Declare PtrSafe Function SetDllDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
Private Declare PtrSafe Function GetProcAddressRegister Lib "kernel32" Alias _
"GetProcAddress" (ByVal hModule&, ByVal lpProcName$) As Long
Private Declare PtrSafe Function CreateThreadForRegister Lib "kernel32" Alias _
"CreateThread" (lpThreadAttributes As Any, ByVal dwStackSize&, ByVal lpStartAddress&, _
ByVal lpparameter&, ByVal dwCreationFlags&, ThreadID&) As Long
#Else
Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll"
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Private Declare Function apiGetLocaleInfo Lib "kernel32"
Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function LoadLibraryRegister Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName$) As Long
Public Declare Function SetDllDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long
Private Declare Function GetProcAddressRegister Lib "kernel32" Alias _
"GetProcAddress" (ByVal hModule&, ByVal lpProcName$) As Long
Private Declare Function CreateThreadForRegister Lib "kernel32" Alias _
"CreateThread" (lpThreadAttributes As Any, ByVal dwStackSize&, ByVal lpStartAddress&, _
ByVal lpparameter&, ByVal dwCreationFlags&, ThreadID&) As Long
#End If