vba 如何获取dll文件的路径

1、新建VBA工程

打开Excel，按下Atl + F11，打开VBA工程。

2、增加一个Form

增加一个Form，Form上有一个Label、一个文本框、一个按钮和一个ListBox控件。文本框用来输入进程的名称，ListBox用来显示dll的路径

3、增加一个模块

新增加一个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

4、增加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

5、获取当前进程的dll路径

选择UserForm1，按F5运行，点击按钮，可以获取当前进程所有dll的路径。

6、获取指定进程的dll路径

选择UserForm1，按F5运行，在本文框中输入进程名称，点击按钮，就可以获取和进程名称匹配的进程的所有dll的路径。

7、下载测试工程代码

测试用的Excel及VBA代码共享在如下位置，可以自行下来测试。

下载路径：http://pan.baidu.com/s/1bpAnpcN