Useful VBA file functions - Microsoft Scripting Runtime

Some example functions for finding out the last modified date of a file, copying a file and deleting a file using VBA.

Public Sub File_Last_Modified_Date()
' Use a function to return the last modified date of a file
    MsgBox f_File_Last_Modified_Date("C:\Put\the\full\file\address\here.xlsx")
End Sub

Private Function f_File_Last_Modified_Date(FileName As String) As String
' In the VBE, set a reference to Microsoft Scripting runtime
' Tools -> References... ->
    Dim fso As Scripting.FileSystemObject
    Dim fsof As Scripting.File
    Dim strPath As String

    Set fso = New FileSystemObject
    strPath = FileName
    Set fsof = fso.GetFile(strPath)
    With fsof
        f_File_Last_Modified_Date = .DateLastModified
    End With

    Set fso = Nothing
    Set fsof = Nothing
End Function

---

Public Sub CopyFile()
' Copy a file, the file cannot be open when the copy is attempted

    Dim SourceFile As String
    Dim DestFile As String

    SourceFile = "C:\Put\the\full\file\address\here.doc"
    DestFile = "C:\Put\the\new\file\address\here.doc"

    FileCopy SourceFile, DestFile
End Sub

Public Sub DeleteFile()
' Delete a file

    Dim FileName As String

    FileName = "C:\Put\the\full\file\address\here.txt"

    ' Check the file exists
    If Dir(FileName) = "" Then
        ' File does not exist
    Else
        ' Delete the file
        Kill FileName
    End If

End Sub

As always, any questions or comments please let us know via the comments section.

Application.Filesearch Replacement For Office 2007

If you have ever used completed a search for files using VBA you probably made use of Application.Filesearch.  However, if you’ve updated to Office 2007 or 2010 you may have noticed that Filesearch has been removed… but the (very) old Dir remains, so you can use this instead, an example of which follows:

Sub FileSearch()
    Dim fso As Object
    Dim FileName As String
    Dim strArr(1 To 65536, 1 To 1) As String
    Dim i As Long

    ' Set the directory / filename you are looking for
    Const strDir As String = "C:\Your\File\Path"
    Const SearchTerm As String = "YourFileNameTerm"

    ' Complete the search
    Let FileName = Dir$(strDir & "\*" & SearchTerm & "*.xls")
    Do While FileName <> vbNullString
        ' For each file found load to the array
        Let i = i + 1
        Let strArr(i, 1) = strDir & "\" & FileName
        Let FileName = Dir$()
    Loop

    ' Search within sub-folders
    Set fso = CreateObject("Scripting.FileSystemObject")
    Call RecurseSubFolders(fso.GetFolder(strDir), strArr(), i, SearchTerm)

    ' Tidy up and copy the results to the active worksheet
    Set fso = Nothing
    If i > 0 Then
        Range("A1").Resize(i).Value = strArr
    End If

End Sub

Private Sub RecurseSubFolders( _
    ByRef Folder As Object, _
    ByRef strArr() As String, _
    ByRef i As Long, _
    ByRef SearchTerm As String)

    Dim SubFolder As Object
    Dim FileName As String

    ' Search sub folders
    For Each SubFolder In Folder.SubFolders
        Let FileName = Dir$(SubFolder.Path & "\*" & SearchTerm & "*.xls")
        Do While FileName <> vbNullString
            Let i = i + 1
            Let strArr(i, 1) = SubFolder.Path & "\" & FileName
            Let FileName = Dir$()
        Loop
        Call RecurseSubFolders(SubFolder, strArr(), i, SearchTerm)
    Next
End Sub

Special Folders using the FileSystemObject

There are several methods to get find out the file paths for Microsoft Windows’ special folders (Systems folder, Temporary folder etc).  The example below uses the FileSystemObject.

Sub Special_Folders()
'-----------------------------------------------------------------
' Procedure : Special_Folders
' Purpose   : Retrieve file path for MS Windows 'special folders'
'             Requires a reference to Microsoft Scripting Runtime
'-----------------------------------------------------------------
'
    On Error GoTo ErrTrap

    Dim oFS As FileSystemObject

    Set oFS = New FileSystemObject

    ' Windows Folder Path
    MsgBox FS.GetSpecialFolder(WindowsFolder)

    ' System Folder - (example - Windows\System32)
    MsgBox oFS.GetSpecialFolder(SystemFolder)

    ' Temporary Folder Path
    MsgBox oFS.GetSpecialFolder(TemporaryFolder)

    If Not oFS Is Nothing Then Set oFS = Nothing

ErrTrap:
    Select Case Err.Number
        Case Is = 0
            ' No error continue
        Case Else
            MsgBox Err.Number & " - " & Err.Description
            Err.Clear
    End Select
End Sub

This routine requires a reference Microsoft Scripting Runtime.