Month: December 2021

VBA check redundant variables

Following with last post, where the code was beautified, next step is to check for redundant declaration of variables. The code came from wikibooks site again, this post, but there are some limitations noted.
But I think that merging both posts, the code can be refactored to check for undeclared variables and reuse some parts of the code to get a VBA parser to other programming languages.

The following code, as it is right now, will only check for redundant declarations. The other ideas should be developed… in a near future, I hope:
‘ https://en.wikibooks.org/wiki/Visual_Basic_for_Applications/Redundant_Variables_List
Continue reading “VBA check redundant variables”

VBA Spy++ alternative

We can interact with Windows’s windows (sic) from within VBA, even if there is not a OCX we can set a reference to and deal with the external application. The usual and ‘inconvenient’ way to do so is via the SendKeys API, but it’s not the only one option out there.
VBA can be used to explore process and windows, and once we  know the window handle (or the caption and ClassName of it),  we can focus on that component and send keys specifically to that window, via SendMessage/PostMessage
So the first step should be to detect the open windows -the ones we need to interact with- (and their children), and get them in a worksheet (or wherever you want to output).
With following code from Mark Rowlinson (www.markrowlinson.co.uk), that copied from here, all windows will be reflected, in blocks of 3 columns (handle, ClassName and Caption), very convenient to get the interaction.
In order to get the list, run GetWindows procedure.
This post is somehow related to these old posts 1,2:

Option Explicit

'Declaring the necessary API functions for both 64 and 32 bit applications.
#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr

'Performs an operation on a specified file.
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

'Retrieves a handle to the top-level window whose class name and window name match the specified strings.
'This function does not search child windows. This function does not perform a case-sensitive search.
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

'Retrieves a handle to a window whose class name and window name match the specified strings.
'The function searches child windows, beginning with the one following the specified child window.
'This function does not perform a case-sensitive search.
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

'Sends the specified message to a window or windows. The SendMessage function calls the window procedure
'for the specified window and does not parentWindowurn until the window procedure has processed the message.
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

'Places (posts) a message in the message queue associated with the thread that created the specified
'window and parentWindowurns without waiting for the thread to process the message.
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
#Else
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
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 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
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 lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

'Constants used in API functions.
Private Const SW_HIDE As Long = 0
Private Const SW_SHOWNORMAL As Long = 1
Private Const SW_SHOWMAXIMIZED As Long = 3
Private Const SW_SHOWMINIMIZED As Long = 2

Private Const WM_SETTEXT = &HC
Private Const VK_RETURN = &HD
Private Const WM_KEYDOWN = &H100

Private cnt As Integer

'Used a user defined type here rather than Enum so that it works on 97
Private Type winEnum
winHandle As Integer
winClass As Integer
winTitle As Integer
winHandleClass As Integer
winHandleTitle As Integer
winHandleClassTitle As Integer
End Type

Private winOutputType As winEnum

Public Sub GetWindows()
' VBA "Clone" of Spy++ application
cnt = 0
winOutputType.winHandle = 0
winOutputType.winClass = 1
winOutputType.winTitle = 2
winOutputType.winHandleClass = 3
winOutputType.winHandleTitle = 4
winOutputType.winHandleClassTitle = 5

GetWinInfo 0&, 0, winOutputType.winHandleClassTitle
End Sub

Private Sub GetWinInfo(hParent As Long, intOffset As Integer, OutputType As Integer)
' Sub to recursively obtain window handles, classes and text
' given a parent window to search
' Written by Mark Rowlinson
' www.markrowlinson.co.uk - The Programming Emporium
' http://www.vbaexpress.com/kb/getarticle.php?kb_id=52#instr

Dim hWnd As Long, lngRet As Long, y As Integer
Dim strText As String

hWnd = FindWindowEx(hParent, 0&, vbNullString, vbNullString)
While hWnd <> 0
With ActiveSheet
Select Case OutputType
Case winOutputType.winClass
strText = String$(100, Chr$(0))
lngRet = GetClassName(hWnd, strText, 100)
.Range("a1").Offset(cnt, intOffset) = Left$(strText, lngRet)
Case winOutputType.winHandle
.Range("a1").Offset(cnt, intOffset) = hWnd
Case winOutputType.winTitle
strText = String$(100, Chr$(0))
lngRet = GetWindowText(hWnd, strText, 100)
If lngRet > 0 Then
.Range("a1").Offset(cnt, intOffset) = Left$(strText, lngRet)
Else
.Range("a1").Offset(cnt, intOffset) = "N/A"
End If
Case winOutputType.winHandleClass
.Range("a1").Offset(cnt, intOffset) = hWnd
strText = String$(100, Chr$(0))
lngRet = GetClassName(hWnd, strText, 100)
.Range("a1").Offset(cnt, intOffset + 1) = Left$(strText, lngRet)
Case winOutputType.winHandleTitle
.Range("a1").Offset(cnt, intOffset) = hWnd
strText = String$(100, Chr$(0))
lngRet = GetWindowText(hWnd, strText, 100)
If lngRet > 0 Then
.Range("a1").Offset(cnt, intOffset + 1) = Left$(strText, lngRet)
Else
.Range("a1").Offset(cnt, intOffset + 1) = "N/A"
End If
Case winOutputType.winHandleClassTitle
.Range("a1").Offset(cnt, intOffset) = hWnd
strText = String$(100, Chr$(0))
lngRet = GetClassName(hWnd, strText, 100)
.Range("a1").Offset(cnt, intOffset + 1) = Left$(strText, lngRet)
strText = String$(100, Chr$(0))
lngRet = GetWindowText(hWnd, strText, 100)
If lngRet > 0 Then
.Range("a1").Offset(cnt, intOffset + 2) = Left$(strText, lngRet)
Else
.Range("a1").Offset(cnt, intOffset + 2) = "N/A"
End If
End Select
End With

' check for children
y = cnt
Select Case OutputType
Case Is > 4: GetWinInfo hWnd, intOffset + 3, OutputType
Case Is > 2: GetWinInfo hWnd, intOffset + 2, OutputType
Case Else: GetWinInfo hWnd, intOffset + 1, OutputType
End Select

' increment by 1 row if no children found
If y = cnt Then cnt = cnt + 1

' now get next window
hWnd = FindWindowEx(hParent, hWnd, vbNullString, vbNullString)
Wend
End Sub


One more piece of code is needed, that is to get the handle from a partial caption, so knowing some part of the caption, you can get the handle:

Option Explicit

#If VBA7 Then
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
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 LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal wCmd As LongPtr) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPtr
#Else
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
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 GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount 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 GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If

' Used a user defined type here rather than Enum so that it works on 97
Private Type winEnum
winHandle As Integer
winClass As Integer
winTitle As Integer
winHandleClass As Integer
winHandleTitle As Integer
winHandleClassTitle As Integer
End Type
Dim winOutputType As winEnum

Private Const GW_HWNDNEXT As Long = 2
' { WM_*: Window messsages
Public Const WM_CHAR = &H102
Public Const WM_CLOSE = &H10
Public Const Wm_CREATE = &H1
Public Const WM_DESTROY = &H2
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_PAINT = &HF
Public Const WM_SETTEXT = &HC
Public Const WM_SETTINGCHANGE = &H1A
Public Const WM_SIZE = &H5
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
' }

Private sCaption As String

#If VBA7 Then
Dim lhWnd As LongPtr
#Else
Dim lhWnd As Long
#End If

#If VBA7 Then
Private Function GetHandleFromPartialCaption(ByRef hWnd As LongPtr, ByRef PartialCaption As String) As Boolean
#Else
Private Function GetHandleFromPartialCaption(ByRef hWnd As Long, ByRef PartialCaption As String) As Boolean
#End If
Dim sStr As String

GetHandleFromPartialCaption = False
lhWnd = FindWindow(vbNullString, vbNullString) 'PARENT WINDOW
Do While lhWnd <> 0
sStr = String(GetWindowTextLength(lhWnd) + 1, Chr$(0))
GetWindowText lhWnd, sStr, Len(sStr)
sStr = Left$(sStr, Len(sStr) - 1)
If InStr(1, sStr, PartialCaption) > 0 Then
PartialCaption = sStr
GetHandleFromPartialCaption = True
hWnd = lhWnd
Exit Do
End If
lhWnd = GetWindow(lhWnd, GW_HWNDNEXT)
Loop
End Function


There is some code and links below, that came from MyEngineeringWorld blog, where Christos Samaras further shows how to interact with a child window once located, that is the reason that to be posted here:
  '-------------
' some samples on how to use the hWnd and ClassName from the above code combined with "SendMessage/PostMessage" so no need for "SendKeys":
' https://myengineeringworld.net/2018/04/open-password-protected-pdf-vba.html
' https://myengineeringworld.net/2013/04/open-pdf-file-with-vba.html
' https://myengineeringworld.net/2013/04/save-web-pages-as-pdf-files.html

Private Sub OpenLockedPdf(pdfPath As String, password As String)
'------------------------------------------------------------------------
'Opens a password-protected PDF file, given its (known) password.
'API functions are used to find the pop-up window and fill the password.
'
'The subroutine can be used in every Office application, as well as
'in AutoCAD. It works for both 32 and 64 bit applications.

'The macro also works with PDF files that are NOT password-protected.
'In that case, the code after the line of ShellExecute is ignored.

'Written By: Christos Samaras
'Date: 30/04/2018
'E-mail: xristos.samaras@gmail.com
'Site: http://www.myengineeringworld.net
'------------------------------------------------------------------------

' Declaring the necessary variables (different for 32 or 64 bit applications).
#If VBA7 And Win64 Then
Dim parentWindow As LongPtr
Dim firstChildWindow As LongPtr
Dim secondChildFirstWindow As LongPtr
#Else
Dim parentWindow As Long
Dim firstChildWindow As Long
Dim secondChildFirstWindow As Long
#End If
Dim timeCount As Date

' Check if the PDF file exists.
If FileExists(pdfPath) = False Then
MsgBox "The PDF file doesn't exist!", vbCritical, "Error in PDF path"
Exit Sub
End If

'The ShellExecute API will try to open the PDF file using the default application that
'is associated with PDF files (either Adobe Reader or Professional).
ShellExecute Application.hWnd, "Open", pdfPath, vbNullString, "C:\", SW_SHOWNORMAL

'Note: The code below will be ignored if the PDF file has no protection.

'Find the handle of the pop-up window.
timeCount = Now()
Do Until Now() > timeCount + TimeValue("00:00:05")
parentWindow = 0
DoEvents
parentWindow = FindWindow("#32770", "Password")
If parentWindow <> 0 Then Exit Do
Loop

If parentWindow <> 0 Then
'Find the handle of the first child window (it is a group box).
timeCount = Now()
Do Until Now() > timeCount + TimeValue("00:00:05")
firstChildWindow = 0
DoEvents
firstChildWindow = FindWindowEx(parentWindow, ByVal 0&, "GroupBox", vbNullString)
If firstChildWindow <> 0 Then Exit Do
Loop

'Find the handle of the subsequent child window (it is the text box for filling the password).
If firstChildWindow <> 0 Then
timeCount = Now()
Do Until Now() > timeCount + TimeValue("00:00:05")
secondChildFirstWindow = 0
DoEvents
secondChildFirstWindow = FindWindowEx(firstChildWindow, ByVal 0&, "RICHEDIT50W", vbNullString)
If secondChildFirstWindow <> 0 Then Exit Do
Loop

'The handle was found, so...
If secondChildFirstWindow <> 0 Then
'Fill the password in the text box.
SendMessage secondChildFirstWindow, WM_SETTEXT, 0&, ByVal password

'Press the OK button (it is the default action, so no need to find the handle of the button).
PostMessage secondChildFirstWindow, WM_KEYDOWN, VK_RETURN, 0
End If
End If
End If
End Sub

Function FileExists(FilePath As String) As Boolean
'Checks if a file exists (using the Dir function... better use File System Object, or store CurDir)
Dim oldCurDir As String

On Error Resume Next
'oldCurDir = VBA.CurDir$() ' store configuration...
If Len(FilePath) > 0 Then
If Not VBA.Dir(FilePath, vbDirectory) = vbNullString Then FileExists = True
End If
'ChDir (oldCurDir) ' restore configuration...
On Error GoTo 0
End Function

VBA DLL explorer

If you want to use DLL from VBA, you’ll need to know which functions are exported on that DLL so that they can be called from within VBA. There is that nirsoft dllExplorer app, but, could that be done with pure VBA code?. For sure, just paste code in normal module, and run listExportedFuncs to get list (in code it’ll show on msgBox -where you can Ctrl+C to copy to clipboard-, or uncomment lines “‘!” to get in file):

' https://renenyffenegger.ch/notes/development/languages/VBA/Win-API/examples/DbgHelp/ListExportedFuncsOfDll
' http://www.tech-archive.net/Archive/VB/microsoft.public.vb.general.discussion/2007-09/msg00228.html
'
Option Explicit

Private Declare Sub MoveMemoryLong Lib "kernel32" Alias "RtlMoveMemory" (Target As Any, ByVal LPointer As Long, ByVal cbCopy As Long)

Private Const IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16
Private Const IMAGE_DIRECTORY_ENTRY_EXPORT = 0
Private Const IMAGE_DIRECTORY_ENTRY_IMPORT = 1

Declare Function MapAndLoad Lib "Imagehlp.dll" (ByVal ImageName As String, ByVal DLLPath As String, LoadedImage As LOADED_IMAGE, DotDLL As Long, ReadOnly As Long) As Long
Declare Function UnMapAndLoad Lib "Imagehlp.dll" (LoadedImage As LOADED_IMAGE) As Long
Declare Function ImageRvaToVa Lib "Imagehlp.dll" (ByVal NTHeaders As Long, ByVal Base As Long, ByVal RVA As Long, ByVal LastRvaSection As Long) As Long

Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpsz As Long) As Long

#If VBA7 Then
Declare Sub PrtSafe RtlMoveMemory Lib "kernel32" (ByRef dest As Any, ByRef source As Any, ByVal size As longPtr)
Declare Sub PrtSafe RtlZeroMemory Lib "kernel32" (dest As Any, ByVal length As Long)
#Else
Declare Sub RtlMoveMemory Lib "kernel32" (ByRef dest As Any, ByRef source As Any, ByVal size As Long)
Declare Sub RtlZeroMemory Lib "kernel32" (dest As Any, ByVal length As Long)
#End If

Type LIST_ENTRY ' { Used by LOADED_IMAGE
FLink As Long
Blink As Long
End Type ' }

Type IMAGE_EXPORT_DIRECTORY_TABLE ' WinNT.h {
Characteristics As Long
TimeDateStamp As Long
MajorVersion As Integer
MinorVersion As Integer
Name As Long
Base As Long
NumberOfFunctions As Long
NumberOfNames As Long
AddressOfFunctions As Long ' Relative virtual address (RVA) from base of image. Points to an array of RVAs of functions/symbols in the module
AddressOfNames As Long ' Relative virtual address (RVA) from base of image
AddressOfNameOrdinals As Long ' Relative virtual address (RVA) from base of image
End Type ' }

Private Type IMAGE_DATA_DIRECTORY ' WinNT.h {
RVA As Long ' Relative VA
size As Long
End Type ' }

Type IMAGE_OPTIONAL_HEADER32 ' WinNT.h {
' Standard fields:
Magic As Integer
MajorLinkerVersion As Byte
MinorLinkerVersion As Byte
SizeOfCode As Long
SizeOfInitializedData As Long
SizeOfUninitializedData As Long
AddressOfEntryPoint As Long
BaseOfCode As Long
BaseOfData As Long

' NT additional fields:
ImageBase As Long
SectionAlignment As Long
FileAlignment As Long
MajorOperatingSystemVersion As Integer
MinorOperatingSystemVersion As Integer
MajorImageVersion As Integer
MinorImageVersion As Integer
MajorSubsystemVersion As Integer
MinorSubsystemVersion As Integer
Win32VersionValue As Long
SizeOfImage As Long
SizeOfHeaders As Long
CheckSum As Long
Subsystem As Integer
DllCharacteristics As Integer
SizeOfStackReserve As Long
SizeOfStackCommit As Long
SizeOfHeapReserve As Long
SizeOfHeapCommit As Long
LoaderFlags As Long
NumberOfRvaAndSizes As Long
' Data directories
DataDirectory(0 To IMAGE_NUMBEROF_DIRECTORY_ENTRIES) As IMAGE_DATA_DIRECTORY ' 17*8 + 96 = 232
End Type ' }

Type IMAGE_FILE_HEADER ' { WinNT.h / COFF file header
Machine As Integer
NumberOfSections As Integer
TimeDateStamp As Long
PointerToSymbolTable As Long
NumberOfSymbols As Long
SizeOfOptionalHeader As Integer
Characteristics As Integer
End Type ' }

Type IMAGE_NT_HEADERS32 ' WinNT.h {
' Compare with IMAGE_NT_HEADERS64, also defined in WinNT.h
'
Signature As Long
FileHeader As IMAGE_FILE_HEADER
OptionalHeader As IMAGE_OPTIONAL_HEADER32 ' or IMAGE_OPTIONAL_HEADER64
End Type ' }
'
' LOADED_IMAGE
' Is defined in both ImageHlp.h and DbgHelp.h
'
Type LOADED_IMAGE ' 48 bytes (46 bytes packed ) ' { Used with MapAndLoad
ModuleName As Long
hFile As Long
MappedAddress As Long ' Base address of mapped file
FileHeader As Long ' Pointer to IMAGE_NT_HEADERS32 ' (Compare with IMAGE_NT_HEADERS64) -- Note: the pointed to IMAGE_NT_HEADERS32 also has a member named FileHeader.
LastRvaSection As Long ' Pointer to first COFF section header (section table)?
NumberOfSections As Long
Sections As Long ' Pointer to IMAGE_SECTION_HEADER (First COFF section header (section table)??)
Characteristics As Long ' Image characteristics value
fSystemImage As Byte ' bool
fDOSImage As Byte ' bool
'
' At least in C, the compiler pads the following two (new) members
' with the previous two bytes into 4 byte so that in C, adding
' or omitting them should not change anything.
'
' fReadOnly as byte ' bool
' Version as byte ' UCHAR
'
' ----------------------------------------------------------
Links As LIST_ENTRY ' 2 longs
SizeOfImage As Long
End Type ' }

Function GetOpenFileName(Optional FileFilter As String = "All files", _
Optional FileExtension As String = "*.*", _
Optional Title As String = "Select a file", _
Optional InitialPath As String = "MyDocs") As String
Dim fDialog As FileDialog, result As Integer
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

'Optional: FileDialog properties
fDialog.AllowMultiSelect = False
fDialog.Title = "Select a file"
If InitialPath = "MyDocs" Then
fDialog.InitialFileName = VBA.Environ$("UserProfile") & "Documents\"
ElseIf InitialPath = "Downloads" Then
fDialog.InitialFileName = VBA.Environ$("UserProfile") & "Downloads\"
Else
fDialog.InitialFileName = VBA.Environ$("SystemDrive") & "Downloads\"
End If
'Optional: Add filters
fDialog.Filters.Clear
fDialog.Filters.Add "DLL files", "*.dll"
If Not FileExtension = "*.*" Then fDialog.Filters.Add "All files", "*.*"

'Show the dialog. -1 means success!
If fDialog.Show = -1 Then
GetOpenFileName = fDialog.SelectedItems(1)
End If
End Function

Sub listExportedFuncs()
Dim img As LOADED_IMAGE
Dim peHeader As IMAGE_NT_HEADERS32
Dim expTable As IMAGE_EXPORT_DIRECTORY_TABLE
Dim strFunctions As String
Dim DLLPath As String

DLLPath = GetOpenFileName 'Application.GetOpenFileName(FileFilter:="DLL files (*.dll), *.dll", Title:="Select DLL file to open", MultiSelect:=True)

If MapAndLoad(DLLPath, DLLPath, img, True, True) = 0 Then
Debug.Print "Could not map " & DLLPath
Exit Sub
End If

On Error GoTo err_

Dim fOut As Integer: fOut = FreeFile
'! Open Environ$("TEMP") & "\exportedFuncs.txt" For Output As #fOut

' Copy PE file header:
RtlMoveMemory ByVal VarPtr(peHeader), ByVal img.FileHeader, LenB(peHeader)

' Get export table offset as relative virtual address (RVAs)
Dim expRVA As Long
expRVA = peHeader.OptionalHeader.DataDirectory(IMAGE_DIRECTORY_ENTRY_EXPORT).RVA

If expRVA = 0 Then
Call UnMapAndLoad(img)
End If

' Convert RVA to VA:
Dim expVA As Long
expVA = ImageRvaToVa(img.FileHeader, img.MappedAddress, expRVA, 0&)

RtlMoveMemory ByVal VarPtr(expTable), ByVal expVA, LenB(expTable)

Dim nofExports As Long
nofExports = expTable.NumberOfNames

Dim ptrToArrayOfExportedFuncNames As Long
Dim ptrToArrayOfExportedFuncAddresses As Long

ptrToArrayOfExportedFuncNames = ImageRvaToVa(img.FileHeader, img.MappedAddress, expTable.AddressOfNames, 0&)
ptrToArrayOfExportedFuncAddresses = ImageRvaToVa(img.FileHeader, img.MappedAddress, expTable.AddressOfFunctions, 0&)

Dim i As Long
For i = 0 To nofExports - 1
Dim RVAfuncName As Long
Dim RVAfuncAddress As Long

MoveMemoryLong RVAfuncName, ptrToArrayOfExportedFuncNames, 4
MoveMemoryLong RVAfuncAddress, ptrToArrayOfExportedFuncAddresses, 4

Dim VAfuncName As Long
Dim VAfuncAddress As Long

VAfuncName = ImageRvaToVa(img.FileHeader, img.MappedAddress, RVAfuncName, 0&)
VAfuncAddress = ImageRvaToVa(img.FileHeader, img.MappedAddress, RVAfuncAddress, 0&)

'! Print #fOut, VAfuncAddress & ": " & LPSTRtoBSTR(VAfuncName)
strFunctions = strFunctions & vbNewLine & VAfuncAddress & ": " & LPSTRtoBSTR(VAfuncName)

ptrToArrayOfExportedFuncNames = ptrToArrayOfExportedFuncNames + 4
ptrToArrayOfExportedFuncAddresses = ptrToArrayOfExportedFuncAddresses + 4
Next i

Call UnMapAndLoad(img)

'! Close #fOut
MsgBox strFunctions
Exit Sub

err_:
Call UnMapAndLoad(img)
Debug.Print "Error occured: " & Err.Description
End Sub

Private Function LPSTRtoBSTR(ByVal lpString As Long) As String
Dim lenS As Long
Dim ptrToZero As Long

lenS = lstrlen(lpString)

LPSTRtoBSTR = String$(lenS, 0)
RtlMoveMemory ByVal StrPtr(LPSTRtoBSTR), ByVal lpString, lenS

LPSTRtoBSTR = StrConv(LPSTRtoBSTR, vbUnicode)

ptrToZero = InStr(1, LPSTRtoBSTR, Chr(0), 0)

If ptrToZero > 0 Then
LPSTRtoBSTR = Left$(LPSTRtoBSTR, ptrToZero - 1)
End If
End Function


Nearly all the code came from Rene Nyffeneger’s outstanding site