I have a not-too-complicated problem which I do not know how to solve in VB.NET 2010.
Currently I have a recursive routine for finding files/and or searching. With a recursive routine I never complete the call until the end and process growth is significant enough to radically slow down the process with the now large stack.
To make maters worse, I use precoding routines which will take wildcards. Which are these:
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, ByRef lpFindFileData As WIN32_FIND_DATA) As Integer
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Integer, ByRef lpFindFileData As WIN32_FIND_DATA) As Integer
Public Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Integer
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Integer) As Integer
Public Declare Function LockWindowUpdate Lib "user32" Alias "LockWindowUpdate" (ByVal hwndLock As Long) As Long
How do I 'cure' this? They don't lend themselves to a non-recursive environment.
.NET 4.0 now contains the enumerate files functionality in a single method call (Directory.EnumerateFiles Method):
Returns an enumerable collection of file names that match a search
pattern in a specified path, and optionally searches subdirectories.
List<string> files = Directory.EnumerateFiles(startFolder, "*.txt",
SearchOption.AllDirectories).ToList();
VB.NET version:
Dim files As List(Of String) = Directory.EnumerateFiles(startFolder, "*.txt", SearchOption.AllDirectories).ToList()
Related
I have an MS Access form that contains Button to open an application. The application is created using c#. I want to get the TextBox in the Form so that I will set a value on it using the MS Access project.
I am using the following code:
hwndParent = FindWindow(vbNullString, "Form1")
If hwndParent <> 0 Then
TextBoxHandle = FindWindowEx(hwndParent, 0&, "WindowsForms10.EDIT.app.0.3cb5890_r6_ad1", vbNullString)
SendMessage TextBoxHandle, WM_SETTEXT, 0&, ByVal strText
End If
Above code is working on my workstation: Windows 10 Pro.
When I open the MS Access in windows 8. it can't find the TextBox.
TextBoxHandle always return 0 in Windows 8. I am sure that the issue is with 3rd parameter in FinWindowEx. I used spy++ from Microsoft to get the value WindowsForms10.EDIT.app.0.3cb5890_r6_ad1 cause when I try to just enter "Edit", it does not work.
Edit: Adjusted answer using information about dynamic name of class from Hans Passant.
First, we're going to declare WinAPI functions to be able to iterate through all windows and get their class name.
Declare PtrSafe Function FindWindowExW Lib "user32" (ByVal hWndParent As LongPtr, Optional ByVal hwndChildAfter As LongPtr, Optional ByVal lpszClass As LongPtr, Optional ByVal lpszWindow As LongPtr) As LongPtr
Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameW" (ByVal hWnd As LongPtr, ByVal lpClassName As LongPtr, ByVal nMaxCount As Long) As Long
Then, we're going to declare a helper function to get the class name from a hWnd:
Public Function GetWindowClass(hWnd As LongPtr) As String
Dim buf(512) As Byte
GetClassName hWnd, varPtr(buf(0)), 255
GetWindowClass = Replace(CStr(buf), Chr(0), "")
End Function
Then, we're going to iterate through all top-level windows, and return the hWnd from the one matching that class name:
Public Function getThehWnd(hWndParent) As LongPtr
Dim hWnd As LongPtr
hWnd = FindWindowExW(hWndParent)
Do While hWnd <> 0
If GetWindowClass(hWnd) Like "WindowsForms10.EDIT.app.0.*" Then
getThehWnd = hWnd
Exit Function
End If
hWnd = FindWindowExW(hWndParent, hWnd)
Loop
End Function
Old answer:
There are numerous things that can go wrong when calling WinAPI functions from VBA with strings. These include passing a string that's not terminated by a null string, and passing a string that's in the wrong encoding.
For that first case, you get unstable behavior. If the string happens to be stored somewhere where there are a lot of zero's in memory, it works. Else, it continues reading bytes from memory and appending them to the string until it finds two bytes that happen to both be 0.
The first case is easily fixed by appending a null character to the end of your string:
TextBoxHandle = FindWindowEx(hwndParent, 0&, "WindowsForms10.EDIT.app.0.3cb5890_r6_ad1" & Chr(0), vbNullString)
Note that you should probably also make that last argument optional. Entering vbNullString there passes a pointer to a zero-length string, that might also not be delimited by a null character, causing WinAPI to read subsequent characters till it finds 2 null bytes. Setting the type to LongPtr and passing 0 (the default value) passes an actual null pointer, which WinAPI expects when no string gets put in.
The second code is more difficult. I tend to use bytearrays to make sure VBA doesn't do weird things
Dim className As Byte(1024)
className = "WindowsForms10.EDIT.app.0.3cb5890_r6_ad1" 'Yes, this is valid, and assigns the first part of the bytearray to a string
FindWindowExW(hwndParent, 0&, VarPtr(className(0)))
The corresponding declaration of FindWindowExW:
Declare PtrSafe Function FindWindowExW Lib "user32" (ByVal hWndParent As LongPtr, Optional ByVal hwndChildAfter As LongPtr, Optional ByVal lpszClass As LongPtr, Optional ByVal lpszWindow As String) As LongPtr
To debug problems and identify specific windows, I use the following function to iterate through all top and child windows, instead of Spy++. This one has the advantage of running in VBA, so you can set breakpoints and watches, which means you can very easily determine the class name and parent window of all open windows:
Public Sub IterateAllWindows(Optional hWnd As LongPtr, Optional EnumLevel = 0)
Dim hwndChild As LongPtr
If hWnd <> 0 Then
Debug.Print String(EnumLevel, "-");
Debug.Print hWnd & ":";
Debug.Print GetWindowName(hWnd);
Debug.Print "(" & GetWindowClass(hWnd) & ")"
hwndChild = FindWindowExW(hWnd)
Do While hwndChild <> 0
IterateAllWindows hwndChild, EnumLevel:=EnumLevel + 1
hwndChild = FindWindowExW(hWnd, hwndChild)
Loop
Else
Dim hWndTopLevel As LongPtr
hWndTopLevel = GetTopWindow
Do While hWndTopLevel <> 0
Debug.Print String(EnumLevel, "-");
Debug.Print hWndTopLevel & ":";
Debug.Print GetWindowName(hWndTopLevel);
Debug.Print "(" & GetWindowClass(hWndTopLevel) & ")"
hwndChild = FindWindowExW(hWndTopLevel)
Do While hwndChild <> 0
IterateAllWindows hwndChild, EnumLevel:=EnumLevel + 1
hwndChild = FindWindowExW(hWndTopLevel, hwndChild)
Loop
hWndTopLevel = GetWindow(hWndTopLevel, 2)
Loop
End If
End Sub
This uses the following 2 helper functions:
Public Function GetWindowName(hWnd As LongPtr) As String
Dim buf(512) As Byte
GetWindowText hWnd, varPtr(buf(0)), 255
GetWindowName = Replace(CStr(buf), Chr(0), "")
End Function
Public Function GetWindowClass(hWnd As LongPtr) As String
Dim buf(512) As Byte
GetClassName hWnd, varPtr(buf(0)), 255
GetWindowClass = Replace(CStr(buf), Chr(0), "")
End Function
Corresponding WinAPI declarations for that sub:
Declare PtrSafe Function GetTopWindow Lib "user32" (Optional ByVal hWnd As LongPtr) As LongPtr
Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal wCmd As Integer) As LongPtr
Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextW" (ByVal hWnd As LongPtr, ByVal lpString As Any, ByVal nMaxCount As Long) As Long
Declare PtrSafe Function FindWindowExW Lib "user32" (ByVal hWndParent As LongPtr, Optional ByVal hwndChildAfter As LongPtr, Optional ByVal lpszClass As LongPtr, Optional ByVal lpszWindow As LongPtr) As LongPtr
Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameW" (ByVal hWnd As LongPtr, ByVal lpClassName As LongPtr, ByVal nMaxCount As Long) As Long
Running this function with a watch on that class name should help you identify if it's top-level or a child window, and if it's a child window, which class it belongs to. You can also modify it to return the hWnd independent of nesting (by using an If getWindowClass = "WindowsForms10.EDIT.app.0.3cb5890_r6_ad1" Then or by checking the title).
I think you should use Spy to conduct the same investigations on Windows 8 as you (presumably) did on Windows 10. Something must be different there, else your code would work.
Sidenote (because it bit me in the past): make sure you run the version of Spy whose 'bitness' (32 bit / 64 bit) matches the application you're interested in, otherwise message logging doesn't work.
Also, sorry for my previous post, it was a load of cr#p.
Edit Ah ha! Hans comments above that the class name is dynamically generated, so that's your problem. So now we know.
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.
My vb6 program was running on 32bit.
Now I have to move it to 64bit.
The lib that I declare below code,the system seem can't get it.
Declare:
Public Declare Function LogonUser Lib "advapi32.dll" _
Alias "LogonUserA" (ByVal lpszUsername As String, _
ByVal lpszDomain As String, ByVal lpszPassword As String, _
ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, _
phToken As Long) As Long
Public Declare Function ImpersonateLoggedOnUser Lib "advapi32.dll" (ByVal hToken As Long) As Long
Public Declare Function RevertToSelf Lib "advapi32.dll" () As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Run Code:
Public Sub Logon(ByVal strAdminUser As String, ByVal _
strAdminPassword As String, ByVal strAdminDomain As String)
Dim lngTokenHandle As Long
Dim lngLogonType As Long
Dim lngLogonProvider As Long
Dim blnResult As Boolean
lngLogonType = 2
lngLogonProvider = 0
blnResult = RevertToSelf()
blnResult = LogonUser(strAdminUser, strAdminDomain, strAdminPassword, _
lngLogonType, lngLogonProvider, _
lngTokenHandle)
blnResult = ImpersonateLoggedOnUser(lngTokenHandle)
CloseHandle (lngTokenHandle)
End Sub
I got the error message
Error 91:Object variable or With block variable not set
Almost people say need to add "ptrsafe" after Declare but there is no ptrsafe in vb6.
How can I declare function lib without "ptrsafe" in the 64bit and vb6 ?
Almost people say need to add "ptrsafe" after Declare but there is no ptrsafe in vb6.
How can I declare function lib without "ptrsafe" in the 64bit and vb6 ?
VBA needs to be able to deal with 64 bit Windows when its run within a 64 bit application such as one of the programs from the 64 bit Office suite.
VB6 runs on its own forever & always as a 32 bit process, it does not need to be 64 bit aware as 64 bit Windows happily emulates 32 bit code with no additional steps required.
Because of this pointer-safe types are not needed, use the 32 bit convention (Long) in VB6.
Your functions declarations are wrong.
You don't have to add the complete path for Lib, only the library name is need.
By add the path, your code fails on 32 bit OS environment, because "C:\Windows\SysWOW64 folder doesn't exists on 32 bit systems.
Public Declare Function LogonUser Lib "advapi32.dll" _
Alias "LogonUserA" (ByVal lpszUsername As String, _
ByVal lpszDomain As String, ByVal lpszPassword As String, _
ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, _
phToken As Long) As Long
Public Declare Function ImpersonateLoggedOnUser Lib "advapi32.dll" (ByVal hToken As Long) As Long
Public Declare Function RevertToSelf Lib "advapi32.dll" () As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
See:
https://support.microsoft.com/en-us/help/248187/how-to-impersonate-a-user-from-active-server-pages
Since you are talking about API declarations the following may be helpful. VB6 does not recognize the LongLong data type (64-bit integer) but it can be faked by using the VB6 Currency data type. The Currency numbers are actually stored as 64-bit integers. The four decimal places are only shown in display by dividing the actual number by 10,000. Depending on the specific API calls you are using, you may need to have dual API declarations and select the correct one at run time. So you also need to be able to detect the "bitness" of the system running.
See the following links:
Detect Bitness
Faking 64-bit Integers
I have a macro in outlook which I want to run on startup sometimes... Odd request I know. I know about the Application_Startup Sub but I am wondering if it is possible to pass command-line arguments to it?
EDIT: our real requirement is to sometimes run a macro on startup based on a command-line argument. I have tried VBS and Application.Run and also the command-line switch /autorun which has been deprecated as of outlook 2003.
You can use the GetCommandLine function which retrieves the command-line string for the current process. To access the function just paste this API declaration at the top of your macro module:
Declare Function GetCommandLineA Lib "Kernel32" () As String
And then in the VBA sub you can use the following code:
Dim cmdLineArgs As String
'Get the commande line string
cmdLineArgs = GetCommandLineA
found this : https://social.msdn.microsoft.com/Forums/en-US/0017d844-3e4a-4115-bc51-cf02ca23db0c/vba-to-fetch-excel-command-line-64-bit?forum=exceldev
posted by : https://social.msdn.microsoft.com/profile/andreas%20killer/?ws=usercard-mini
'Note: Declaration is overloaded with LONG!
#If Win64 Then
Private Declare PtrSafe Function GetCommandLineL Lib "kernel32" Alias "GetCommandLineA" () As LongPtr
Private Declare PtrSafe Function lstrcpyL Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As LongPtr) As Long
Private Declare PtrSafe Function lstrlenL Lib "kernel32" Alias "lstrlenA" (ByVal lpString As LongPtr) As Long
#Else
Private Declare Function GetCommandLineL Lib "kernel32" Alias "GetCommandLineA" () As Long
Private Declare Function lstrcpyL Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrlenL Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
#End If
'
Function GetCommandLine() As String
#If Win64 Then
Dim lngPtr As LongPtr
#Else
Dim lngPtr As Long
#End If
Dim strReturn As String
Dim StringLength As Long
lngPtr = GetCommandLineL ' Get the pointer to the commandline string
StringLength = lstrlenL(lngPtr) ' get the length of the string (not including the terminating null character):
strReturn = String$(StringLength + 1, 0) ' initialize our string so it has enough characters including the null character:
lstrcpyL strReturn, lngPtr ' copy the string we have a pointer to into our new string:
GetCommandLine = Left$(strReturn, StringLength) ' now strip off the null character at the end:
End Function
Sub getCmdLine()
Debug.Print GetCommandLine()
End Sub
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