![如何快速学习：[1]Swift编程语言](https://exp-picture.cdn.bcebos.com/fb738d9c2cf7dfb2f57a949fd01b1edef5dc13fa.jpg)
如何快速学习：[1]Swift编程语言,Swift，苹果于2014年WWDC（苹果开发者大会）发布的新开发语言，可与Ojective-C*共同运行于MacOS和iOS平台，用于搭建基于苹果平台的应用程......
2023-03-17 270 编程语言
vba 如何获取dll文件的路径
来源：互联网
2023-03-17 00:17:27 68
本文说明在vba中如何获取进程加载的dll文件的路径。
工具/原料
- 32位Office 2007以上或VB6
方法/步骤
新建VBA工程
打开Excel，按下Atl F11，打开VBA工程。
增加一个Form
增加一个Form，Form上有一个Label、一个文本框、一个按钮和一个ListBox控件。文本框用来输入进程的名称，ListBox用来显示dll的路径
增加一个模块
新增加一个VBA模块，贴入如下代码。
Option Explicit
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const WINNT_System_Found = 2
Type PROCESS_MEMORY_COUNTERS
cb As Long
PageFaultCount As Long
PeakWorkingSetSize As Long
WorkingSetSize As Long
QuotaPeakPagedPoolUsage As Long
QuotaPagedPoolUsage As Long
QuotaPeakNonPagedPoolUsage As Long
QuotaNonPagedPoolUsage As Long
PagefileUsage As Long
PeakPagefileUsage As Long
End Type
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long '1 = Windows 95.
'2 = Windows NT
szCSDVersion As String * 128
End Type
Public Declare Function GetProcessMemoryInfo Lib "PSAPI.DLL" (ByVal hProcess As Long, ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long
Public Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Public Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Public Declare Function EnumProcesses Lib "PSAPI.DLL" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Sub GetDLLs(ByVal EXEName As String, list As Collection)
Dim lngLength As Long
Dim strProcessName As String
Dim lngCBSize As Long 'Specifies the size, In bytes, of the lpidProcess array
Dim lngCBSizeReturned As Long 'Receives the number of bytes returned
Dim lngNumElements As Long
Dim lngProcessIDs() As Long
Dim lngCBSize2 As Long
Dim lngModules(1 To 200) As Long
Dim lngReturn As Long
Dim strModuleName As String
Dim lngSize As Long
Dim lngHwndProcess As Long
Dim lngLoop As Long
Dim pmc As PROCESS_MEMORY_COUNTERS
Dim lRet As Long
Dim strProcName2 As String
Dim llLoop As Long
Dim llEnd As Long
'Turn on Error handler
On Error GoTo Error_handler
EXEName = UCase$(Trim$(EXEName))
lngLength = Len(EXEName)
lngCBSize = 8 ' Really needs To be 16, but Loop will increment prior to calling API
lngCBSizeReturned = 96
If EXEName > "" Then
Do While lngCBSize = lngCBSizeReturned
DoEvents
'Increment Size
lngCBSize = lngCBSize * 2
'Allocate Memory for Array
ReDim lngProcessIDs(lngCBSize / 4) As Long
'Get Process ID's
lngReturn = EnumProcesses(lngProcessIDs(1), lngCBSize, lngCBSizeReturned)
Loop
lngNumElements = lngCBSizeReturned / 4
Else
ReDim lngProcessIDs(1) As Long
lngProcessIDs(1) = GetCurrentProcessId
lngNumElements = 1
End If
'Count number of processes returned
'Loop thru each process
For lngLoop = 1 To lngNumElements
'Get a handle to the Process and Open
lngHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lngProcessIDs(lngLoop))
If lngHwndProcess > 0 Then
'Get an array of the module handles for the specified process
lngReturn = EnumProcessModules(lngHwndProcess, lngModules(1), 200, lngCBSize2)
'If the Module Array is retrieved, Get the ModuleFileName
If lngReturn > 0 Then
llEnd = lngCBSize2 / 4
'Buffer with spaces first to allocate memory for byte array
strModuleName = Space(MAX_PATH)
'Must be set prior to calling API
lngSize = 500
'Get Process Name
lngReturn = GetModuleFileNameExA(lngHwndProcess, lngModules(1), strModuleName, lngSize)
'Remove trailing spaces
strProcessName = Left(strModuleName, lngReturn)
'Check for Matching Upper case result
strProcessName = UCase$(Trim$(strProcessName))
strProcName2 = GetElement(Trim(Replace(strProcessName, Chr$(0), "")), "\", 0, 0, _
GetNumElements(Trim(Replace(strProcessName, Chr$(0), "")), "\") - 1)
'All the items for the process
If EXEName = "" Or strProcName2 = ExtractFileName(EXEName) Then
For llLoop = 1 To llEnd
lngReturn = GetModuleFileNameExA(lngHwndProcess, lngModules(llLoop), strModuleName, lngSize)
'Remove trailing spaces
strProcessName = Left(strModuleName, lngReturn)
'Check for Matching Upper case result
strProcessName = UCase$(Trim$(strProcessName))
' strProcName2 = GetElement(Trim(Replace(strProcessName, Chr$(0), "")), "\", 0, 0, _
GetNumElements(Trim(Replace(strProcessName, Chr$(0), "")), "\") - 1)
'Add path to the Collection
If Right$(strProcessName, 4) = ".DLL" Then list.Add strProcessName
Next
'Get the Site of the Memory Structure
pmc.cb = LenB(pmc)
lRet = GetProcessMemoryInfo(lngHwndProcess, pmc, pmc.cb)
End If
End If
End If
'Close the handle to this process
lngReturn = CloseHandle(lngHwndProcess)
'DoEvents
Next
IsProcessRunning_Exit:
'Exit early to avoid error handler
Exit Sub
Error_handler:
Err.Raise Err, Err.Source, "ProcessInfo", Error
Resume Next
End Sub
Private Function ExtractFileName(ByVal vStrFullPath As String) As String
Dim intPos As Integer
intPos = InStrRev(vStrFullPath, "\")
ExtractFileName = UCase$(Mid$(vStrFullPath, intPos 1))
End Function
Private Function getOsVersion() As Long
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
getOsVersion = osinfo.dwPlatformId
End Function
Public Function GetElement(ByVal strList As String, ByVal strDelimiter As String, ByVal lngNumColumns As Long, ByVal lngRow As Long, ByVal lngColumn As Long) As String
Dim lngCounter As Long
' Append delimiter text to the end of the list as a terminator.
strList = strList & strDelimiter
' Calculate the offset for the item required based on the number of columns the list
' 'strList' has i.e. 'lngNumColumns' and from which row the element is to be
' selected i.e. 'lngRow'.
lngColumn = IIf(lngRow = 0, lngColumn, (lngRow * lngNumColumns) lngColumn)
' Search for the 'lngColumn' item from the list 'strList'.
For lngCounter = 0 To lngColumn - 1
' Remove each item from the list.
strList = Mid$(strList, InStr(strList, strDelimiter) Len(strDelimiter), Len(strList))
' If list becomes empty before 'lngColumn' is found then just
' return an empty string.
If Len(strList) = 0 Then
GetElement = ""
Exit Function
End If
Next lngCounter
' Return the sought list element.
GetElement = Left$(strList, InStr(strList, strDelimiter) - 1)
End Function
Public Function GetNumElements(ByVal strList As String, ByVal strDelimiter As String) As Integer
Dim intElementCount As Integer
' If no elements in the list 'strList' then just return 0.
If Len(strList) = 0 Then
GetNumElements = 0
Exit Function
End If
' Append delimiter text to the end of the list as a terminator.
strList = strList & strDelimiter
' Count the number of elements in 'strlist'
While InStr(strList, strDelimiter) > 0
intElementCount = intElementCount 1
strList = Mid$(strList, InStr(strList, strDelimiter) 1, Len(strList))
Wend
' Return the number of elements in 'strList'.
GetNumElements = intElementCount
End Function
增加Command按钮事件
双击Command按钮，增加如下代码：
Private Sub CommandButton1_Click()
Dim objDlls As New Collection
Dim lngIndex As Long
GetDLLs TextBox1.Text, objDlls
ListBox1.Clear
For lngIndex = 1 To objDlls.Count
ListBox1.AddItem objDlls(lngIndex)
Next
End Sub
获取当前进程的dll路径
选择UserForm1，按F5运行，点击按钮，可以获取当前进程所有dll的路径。
获取指定进程的dll路径
选择UserForm1，按F5运行，在本文框中输入进程名称，点击按钮，就可以获取和进程名称匹配的进程的所有dll的路径。
下载测试工程代码
测试用的Excel及VBA代码共享在如下位置，可以自行下来测试。
下载路径：http://pan.baidu.com/s/1bpAnpcN
注意事项
- 本经验还会不断补充和完善，直到有一天我们发现这篇经验已无存在价值。
- 如果有朋友喜欢这篇经验，请为我点赞，后续还会为大家分享更多经验，有兴趣的亲们可以点击关注我。
以上方法由办公区教程网编辑摘抄自百度经验可供大家参考！
相关文章
- 详细阅读
-
web图表开发工具FineReport：[11]连续分组详细阅读
![web图表开发工具FineReport：[11]连续分组](https://exp-picture.cdn.bcebos.com/6002c9d4483104eb360a59bb092b74ee1d324e01.jpg)
web图表开发工具FineReport：[11]连续分组,数据库表数据是按照时间先后录入的，查询的时候希望按照时间先后，某个字段连续相同的话就合并起来显示，这样的报表可以通过相邻连续分组来实现。......
2023-03-17 499 编程语言
- 详细阅读
