Results 1 to 3 of 3
  1. #1
    Star Lounger
    Join Date
    Aug 2002
    Location
    Michigan, USA
    Posts
    52
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Find .exe path using VBA Only (2000)

    What kind of VBA code can I use to return the file path of an .exe. For Example, I want a command that will search the hard dirve for a file called "dod.exe" and then return the path where it was found. I am using VBA code only (through a Microsoft Access database). Any help would be greatly appreciated!

  2. #2
    Star Lounger
    Join Date
    Aug 2002
    Location
    Michigan, USA
    Posts
    52
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Find .exe path using VBA Only (2000)

    I have figured this out, and am posting the solution for the rest of those that may benefit. Full credit goes to KPD-Team 1999, with the rest of the credit going to me since I had to convert code to be VBA access specific, but it seems to be a good start:
    You should change the following variables within the code below to whatever path you want to work on, and whatever file you want to find:
    SearchPath = "C:Program FilesDay of Defeat"
    FindStr = "dod.exe"


    Option Compare Database

    Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
    Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

    Const MAX_PATH = 260
    Const MAXDWORD = &HFFFF
    Const INVALID_HANDLE_VALUE = -1
    Const FILE_ATTRIBUTE_ARCHIVE = &H20
    Const FILE_ATTRIBUTE_DIRECTORY = &H10
    Const FILE_ATTRIBUTE_HIDDEN = &H2
    Const FILE_ATTRIBUTE_NORMAL = &H80
    Const FILE_ATTRIBUTE_READONLY = &H1
    Const FILE_ATTRIBUTE_SYSTEM = &H4
    Const FILE_ATTRIBUTE_TEMPORARY = &H100

    Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
    End Type

    Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
    End Type
    Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
    OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
    End Function

    Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
    'KPD-Team 1999
    'E-Mail: KPDTeam@Allapi.net
    'URL: http://www.allapi.net/
    'Modified for VBA specific code by Steven Swamba

    Dim FileName As String ' Walking filename variable...
    Dim DirName As String ' SubDirectory Name
    Dim dirNames() As String ' Buffer for directory name entries
    Dim nDir As Integer ' Number of directories in this path
    Dim i As Integer ' For-loop counter...
    Dim hSearch As Long ' Search Handle
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Integer
    If Right(path, 1) <> "" Then path = path & ""
    ' Search for subdirectories.
    nDir = 0
    ReDim dirNames(nDir)
    Cont = True
    hSearch = FindFirstFile(path & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
    Do While Cont
    DirName = StripNulls(WFD.cFileName)
    ' Ignore the current and encompassing directories.
    If (DirName <> ".") And (DirName <> "..") Then
    ' Check for directory with bitwise comparison.
    If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
    dirNames(nDir) = DirName
    DirCount = DirCount + 1
    nDir = nDir + 1
    ReDim Preserve dirNames(nDir)
    End If
    End If
    Cont = FindNextFile(hSearch, WFD) 'Get next subdirectory.
    Loop
    Cont = FindClose(hSearch)
    End If
    ' Walk through this directory and sum file sizes.
    hSearch = FindFirstFile(path & SearchStr, WFD)
    Cont = True
    If hSearch <> INVALID_HANDLE_VALUE Then
    While Cont
    FileName = StripNulls(WFD.cFileName)
    If (FileName <> ".") And (FileName <> "..") Then
    FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
    FileCount = FileCount + 1
    MsgBox path & FileName
    End If
    Cont = FindNextFile(hSearch, WFD) ' Get next file
    Wend
    Cont = FindClose(hSearch)
    End If
    ' If there are sub-directories...
    If nDir > 0 Then
    ' Recursively walk into them...
    For i = 0 To nDir - 1
    FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "", SearchStr, FileCount, DirCount)
    Next i
    End If
    End Function


    Private Sub Command0_Click()

    Dim SearchPath As String, FindStr As String
    Dim FileSize As Long
    Dim NumFiles As Integer, NumDirs As Integer

    Screen.MousePointer = 11
    SearchPath = "C:Program FilesDay of Defeat"
    FindStr = "dod.exe"
    FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
    MsgBox NumFiles & " Files found in " & NumDirs + 1 & " Directories"
    MsgBox "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes"
    Screen.MousePointer = 1


    End Sub

  3. #3
    Plutonium Lounger
    Join Date
    Dec 2000
    Location
    Sacramento, California, USA
    Posts
    16,775
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Find .exe path using VBA Only (2000)

    Is there some reason for using API calls instead of the FileSearch Object? Thisis from the help file.

    <pre>With Application.FileSearch
    .NewSearch
    .LookIn = "C:My Documents"
    .SearchSubFolders = True
    .FileName = "Run"
    .MatchTextExactly = True
    .FileType = msoFileTypeAllFiles
    End With</pre>

    Charlotte

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •