4
\$\begingroup\$

I wrote 3 subroutines related to batch data processing, they will be used together. A bit of background, I wrote this for my admin colleagues who do not write code. An application dumps daily .ack files onto a shared drive which contain data processing messages (success, errors, etc.).

I wrote the code with comments aimed at my colleagues, hence stating what would be obvious to someone who knows VBA, please be mindful of that; they are intended so they can modify the data locations and such for their own purposes.

The first two subs are quite simple but if something can be improved it would be great:

Sub Copy_Files_With_Specific_Extension()

    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String

    ' change the value in quotes to the source and destination path you need
    FromPath = "C:\Users\fveilleux-gaboury\Documents"
    ToPath = "C:\test"
    ' change the value in quotes to the file extension you want to copy
    ' change the value to "*.* to copy all file types
    FileExt = "*.ack*"

    ' DO NOT CHANGE ANYTHING BELOW THIS LINE

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox "Source folder " & FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox "Destination folder " & ToPath & " doesn't exist"
        Exit Sub
    End If

    FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath

    Set FSO = Nothing

End Sub

Sub Rename_File_Extension()

    Dim FileName As String
    Dim FSO As Object
    Dim Folder As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")
    ' change the value inside the quotes to the folder containing the files
    Set Folder = FSO.GetFolder("C:\test")

    Dim OldText As String
    Dim NewText As String
    ' change the value inside the quotes to find and replace different extensions
    OldText = ".ack"
    NewText = ".txt"

    ' DO NOT CHANGE ANYTHING BELOW THIS LINE

    For Each File In Folder.Files
        If InStr(1, File.Name, OldText) <> 0 Then
            FileName = Replace(File.Name, OldText, NewText)
            File.Name = FileName
        End If
    Next

    MsgBox "File extension " & OldText & " has been replaced with " & NewText & " in folder " & Folder

    Set FSO = Nothing
    Set Folder = Nothing

End Sub

This sub is more complicated and I would really want to improve it. It loops through a folder to grab all the file names, puts them in an array, then another loop goes over the indexes and performs IO functions. The output is a large text file which contains every line of data from all of the input files (which I can then import into an Access database for further processing).

Sub Combine_Text_Files()

    ' change the value inside the quotes to the folder containing the files
    ' only supports plain text files *.txt
    Dim InputDirPath As String
    InputDirPath = "C:\test\"

    ' change the value inside the quotes to the folder where you want the output file to go
    Dim OutputDirPath As String
    OutputDirPath = "C:\"
    ' change the value inside the quotes to the desired output file name
    Dim OutputFileName As String
    OutputFileName = "_CombinedOutput.txt"

    ' DO NOT CHANGE ANYTHING BELOW THIS LINE

    If Right(InputDirPath, 1) <> "\" Then
        InputDirPath = InputDirPath & "\"
    End If
    If Right(OutputDirPath, 1) <> "\" Then
        OutputDirPath = OutputDirPath & "\"
    End If

    Dim InputFileType As String
    InputFileType = "*.txt"
    Dim InputFileName As String
    InputFileName = Dir$(InputDirPath & InputFileType)
    Dim FileArray() As String
    Dim i As Integer: i = 0

    Do Until InputFileName = vbNullString
        ReDim Preserve FileArray(0 To i)
        FileArray(i) = InputFileName
        InputFileName = Dir$
        i = i + 1
    Loop

    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    Dim Stream As Object
    Set Stream = FSO.CreateTextFile((OutputDirPath & OutputFileName), OverWrite:=True, Unicode:=False)


    Dim FileNameAndPath As String

    For i = LBound(FileArray) To UBound(FileArray)
        FileNameAndPath = (InputDirPath & FileArray(i))
        Debug.Print ("Processing: " & FileNameAndPath)

        Dim FileToCopy As File
        Set FileToCopy = FSO.GetFile(FileNameAndPath)

        Dim StreamToCopy As TextStream
        Set StreamToCopy = FileToCopy.OpenAsTextStream(ForReading)

        Dim CopiedText As String
        CopiedText = StreamToCopy.ReadAll

        Stream.WriteLine CopiedText
        Debug.Print ("Appended to " & OutputFileName & ": " & FileNameAndPath)
    Next i

    MsgBox InputFileType & " files in " & InputDirPath & " have been merged together." & vbNewLine _
        & "You can find the output file " & OutputFileName & " in this location:" & vbNewLine _
        & OutputDirPath

    Stream.Close
    Set FSO = Nothing
    Set Stream = Nothing

End Sub
\$\endgroup\$
  • 3
    \$\begingroup\$ ' DO NOT CHANGE ANYTHING BELOW THIS LINE is usually better written as ' HERE BE DRAGONS ;) \$\endgroup\$ – Mathieu Guindon Mar 26 '15 at 19:45
  • \$\begingroup\$ I would note that set FSO=Nothing is superfluous in current vba models, and adds nothing to the program. Remove those completely, and avoid any questions about what to do when you don't set an object to nothing \$\endgroup\$ – SeanC Mar 27 '15 at 16:29
5
\$\begingroup\$

given the fact that you wrote it for your colleagues who may change it in future, I'd have all the code in one module to make it a bit clear for them.

The code is well structured and easy to read. I'd change just couple of things

  1. Error handling

You currently do:

Sub Copy_Files_With_Specific_Extension()

    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String

    ' change the value in quotes to the source and destination path you need
    FromPath = "C:\Users\fveilleux-gaboury\Documents"
    ToPath = "C:\test"
    ' change the value in quotes to the file extension you want to copy
    ' change the value to "*.* to copy all file types
    FileExt = "*.ack*"

    ' DO NOT CHANGE ANYTHING BELOW THIS LINE

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox "Source folder " & FromPath & " doesn't exist"
        Exit Sub
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox "Destination folder " & ToPath & " doesn't exist"
        Exit Sub
    End If

    FSO.CopyFile SOURCE:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath

    Set FSO = Nothing

End Sub

which means that your FSO object may not be disposed correctly if any of the condition is true, like here

If FSO.FolderExists(FromPath) = False Then
   MsgBox "Source folder " & FromPath & " doesn't exist"
   Exit Sub
 End If

I'd change all your methods to support proper error handling like here:

Public Sub Copy_Files_With_Specific_Extension()

    Const SOURCE    As String = "Copy_Files_With_Specific_Extension"

    Dim FSO         As Object
    Dim FromPath    As String
    Dim ToPath      As String
    Dim FileExt     As String

    On Error GoTo ErrorHandler

    ' change the value in quotes to the source and destination path you need
    FromPath = "C:\Users\fveilleux-gaboury\Documents"
    ToPath = "C:\test"
    ' change the value in quotes to the file extension you want to copy
    ' change the value to "*.* to copy all file types
    FileExt = "*.ack*"

    ' DO NOT CHANGE ANYTHING BELOW THIS LINE

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox "Source folder " & FromPath & " doesn't exist"
        GoTo ExitRoutine
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox "Destination folder " & ToPath & " doesn't exist"
        GoTo ExitRoutine
    End If

    FSO.CopyFile SOURCE:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath

ExitRoutine:
    Set FSO = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "Hey mate, something went wrong, call me and tell me this" & vbNewLine & _
           "Method name: " & SOURCE & vbNewLine & _
           "Error code: " & Err.Number & vbNewLine & _
           "Error description: " & Err.Description
    GoTo ExitRoutine

End Sub

if any of your conditions are true or if any unexpected error is thrown, the FSO object will be always properly disposed.

  1. My assumption is that the source folder and the destination folder may change in future and I don't think your colleagues have to go to the code and change it. I'd write a code that will allow them to change the folder as they need and set the folder you mentioned as default

Here is code I use (but didn't write it):

Option Explicit

Private Type BrowseInfo
   hWndOwner As Long
   pIDLRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfnCallback As Long
   lParam As Long
   iImage As Long
End Type

Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_EDITBOX = &H10
Public Const BIF_VALIDATE = &H20
Public Const BIF_NEWDIALOGSTYLE = &H40
Public Const BIF_USENEWUI = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)
Public Const BIF_BROWSEINCLUDEURLS = &H80
Public Const BIF_UAHINT = &H100
Public Const BIF_NONEWFOLDERBUTTON = &H200
Public Const BIF_NOTRANSLATETARGETS = &H400
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000
Public Const BIF_BROWSEINCLUDEFILES = &H4000
Public Const BIF_SHAREABLE = &H8000
Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)

Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Private mstrSTARTFOLDER As String
Public Function GetFolder(ByVal hWndModal As Long, _
                          Optional StartFolder As String = "", _
                          Optional Title As String = "Please select a folder:", _
                          Optional IncludeFiles As Boolean = False, _
                          Optional IncludeNewFolderButton As Boolean = False) As String

    Dim bInf As BrowseInfo
    Dim RetVal As Long
    Dim PathID As Long
    Dim RetPath As String
    Dim Offset As Integer
    'Set the properties of the folder dialog
    bInf.hWndOwner = hWndModal
    bInf.pIDLRoot = 0
    bInf.lpszTitle = Title
    bInf.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_STATUSTEXT
    If IncludeFiles Then bInf.ulFlags = bInf.ulFlags Or BIF_BROWSEINCLUDEFILES
    If IncludeNewFolderButton Then bInf.ulFlags = bInf.ulFlags Or BIF_NEWDIALOGSTYLE
    If StartFolder <> "" Then
       mstrSTARTFOLDER = StartFolder & vbNullChar
       bInf.lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc) 'get address of function.
   End If
    'Show the Browse For Folder dialog
    PathID = SHBrowseForFolder(bInf)
    RetPath = Space$(512)
    RetVal = SHGetPathFromIDList(ByVal PathID, ByVal RetPath)
    If RetVal Then
         'Trim off the null chars ending the path
         'and display the returned folder
         Offset = InStr(RetPath, Chr$(0))
         GetFolder = Left$(RetPath, Offset - 1)
         'Free memory allocated for PIDL
         CoTaskMemFree PathID
    Else
         GetFolder = ""
    End If
End Function
Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
   On Error Resume Next
   Dim lpIDList As Long
   Dim ret As Long
   Dim sBuffer As String
   Select Case uMsg
       Case BFFM_INITIALIZED
           Call SendMessage(hWnd, BFFM_SETSELECTION, 1, mstrSTARTFOLDER)
       Case BFFM_SELCHANGED
           sBuffer = Space(MAX_PATH)
           ret = SHGetPathFromIDList(lp, sBuffer)
           If ret = 1 Then
               Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
           End If
   End Select
   BrowseCallbackProc = 0
End Function
Private Function GetAddressofFunction(add As Long) As Long
 GetAddressofFunction = add
End Function

and how I implemented it to your code:

Public Sub Copy_Files_With_Specific_Extension()

    Const SOURCE    As String = "Copy_Files_With_Specific_Extension"

    Dim FSO         As Object
    Dim FromPath    As String
    Dim ToPath      As String
    Dim FileExt     As String

    On Error GoTo ErrorHandler

    ' change the value in quotes to the source and destination path you need
    FromPath = GetFolder(hWndModal:=0, _
                         StartFolder:="C:\Users\fveilleux-gaboury\Documents", _
                         Title:="Select the source folder that contains all the *.ack* files", _
                         IncludeNewFolderButton:=True)

the change means they will have to make one extra click if the folder is correct but on other side it will give them ability to change it easily in future if needed.

The same way you can do the **C:\test** folder but here I'd consider to make the path as a constant that will be at top of your module and any change applied to the constant will be reflected to all places in your code

Const WORKING_FOLDER    As String = "C:\test"

Public Sub Copy_Files_With_Specific_Extension()

...
    ToPath = WORKING_FOLDER
...

Sub Rename_File_Extension()
...
    Set Folder = FSO.GetFolder(WORKING_FOLDER)
...

Sub Combine_Text_Files()
...
    InputDirPath = WORKING_FOLDER
...

I noticed that you use for your ack files two 'formats:

FileExt = "*.ack*"
OldText = ".ack"

Is this intended? If it should be the same, again, I'd make a constant at top of your module to make it easy for change in future = one place

Finally your Combine_Text_Files method. I do find your method readable and appropriate. I'm not sure if there is any better/faster method for reading and appending text files but if it's not slow just use it. I found some minor bugs there like **ForReading* constant and not disposing some object variables but otherwise it seems to be OK

Here is how it looks like in my editor after all the changes

    Option Explicit

Const WORKING_FOLDER    As String = "C:\test"

Public Sub Copy_Files_With_Specific_Extension()

    Const SOURCE    As String = "Copy_Files_With_Specific_Extension"

    Dim FSO         As Object
    Dim FromPath    As String
    Dim ToPath      As String
    Dim FileExt     As String

    On Error GoTo ErrorHandler

    ' change the value in quotes to the source and destination path you need
    FromPath = GetFolder(hWndModal:=0, _
                         StartFolder:="C:\Users\fveilleux-gaboury\Documents", _
                         Title:="Select the source folder that contains all the *.ack* files", _
                         IncludeNewFolderButton:=True)

    ToPath = WORKING_FOLDER
    ' change the value in quotes to the file extension you want to copy
    ' change the value to "*.* to copy all file types
    FileExt = "*.ack*"

    ' DO NOT CHANGE ANYTHING BELOW THIS LINE

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox "Source folder " & FromPath & " doesn't exist"
        GoTo ExitRoutine
    End If

    If FSO.FolderExists(ToPath) = False Then
        MsgBox "Destination folder " & ToPath & " doesn't exist"
        GoTo ExitRoutine
    End If

    FSO.CopyFile SOURCE:=FromPath & FileExt, Destination:=ToPath
    MsgBox "You can find the files from " & FromPath & " in " & ToPath

ExitRoutine:
    Set FSO = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "Hey mate, something went wrong, call me and tell me this" & vbNewLine & _
           "Method name: " & SOURCE & vbNewLine & _
           "Error code: " & Err.Number & vbNewLine & _
           "Error description: " & Err.Description, vbExclamation, "Unexpected error at " & SOURCE
    GoTo ExitRoutine

End Sub

Sub Rename_File_Extension()

    Const SOURCE    As String = "Rename_File_Extension"

    Dim FileName    As String
    Dim FSO         As Object
    Dim Folder      As Object
    Dim File        As Object

    On Error GoTo ErrorHandler

    Set FSO = CreateObject("Scripting.FileSystemObject")
    ' change the value inside the quotes to the folder containing the files
    Set Folder = FSO.GetFolder(WORKING_FOLDER)

    Dim OldText As String
    Dim NewText As String
    ' change the value inside the quotes to find and replace different extensions
    OldText = ".ack"
    NewText = ".txt"

    ' DO NOT CHANGE ANYTHING BELOW THIS LINE

    For Each File In Folder.Files
        If InStr(1, File.Name, OldText) <> 0 Then
            FileName = Replace(File.Name, OldText, NewText)
            File.Name = FileName
        End If
    Next

    MsgBox "File extension " & OldText & " has been replaced with " & NewText & " in folder " & Folder

ExitRoutine:
    Set FSO = Nothing
    Set Folder = Nothing
    Set File = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "Hey mate, something went wrong, call me and tell me this" & vbNewLine & _
           "Method name: " & SOURCE & vbNewLine & _
           "Error code: " & Err.Number & vbNewLine & _
           "Error description: " & Err.Description, vbExclamation, "Unexpected error at " & SOURCE
    GoTo ExitRoutine

End Sub

Sub Combine_Text_Files()

    Const SOURCE            As String = "Combine_Text_Files"
    Const fso_ForReading    As Integer = 1

    ' change the value inside the quotes to the folder containing the files
    ' only supports plain text files *.txt
    Dim InputDirPath As String
    On Error GoTo ErrorHandler

    InputDirPath = WORKING_FOLDER

    ' change the value inside the quotes to the folder where you want the output file to go
    Dim OutputDirPath As String
    OutputDirPath = "C:\"
    ' change the value inside the quotes to the desired output file name
    Dim OutputFileName As String
    OutputFileName = "_CombinedOutput.txt"

    ' DO NOT CHANGE ANYTHING BELOW THIS LINE

    If Right(InputDirPath, 1) <> "\" Then
        InputDirPath = InputDirPath & "\"
    End If
    If Right(OutputDirPath, 1) <> "\" Then
        OutputDirPath = OutputDirPath & "\"
    End If

    Dim InputFileType As String
    InputFileType = "*.txt"
    Dim InputFileName As String
    InputFileName = Dir$(InputDirPath & InputFileType)
    Dim FileArray() As String
    Dim i As Integer: i = 0

    Do Until InputFileName = vbNullString
        ReDim Preserve FileArray(0 To i)
        FileArray(i) = InputFileName
        InputFileName = Dir$
        i = i + 1
    Loop

    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    Dim Stream As Object
    Set Stream = FSO.CreateTextFile((OutputDirPath & OutputFileName), OverWrite:=True, Unicode:=False)


    Dim FileNameAndPath As String

    For i = LBound(FileArray) To UBound(FileArray)
        FileNameAndPath = (InputDirPath & FileArray(i))
        Debug.Print ("Processing: " & FileNameAndPath)

        Dim FileToCopy As Object
        Set FileToCopy = FSO.GetFile(FileNameAndPath)

        Dim StreamToCopy As Object
        Set StreamToCopy = FileToCopy.OpenAsTextStream(fso_ForReading)

        Dim CopiedText As String
        CopiedText = StreamToCopy.ReadAll

        Stream.WriteLine CopiedText
        Debug.Print ("Appended to " & OutputFileName & ": " & FileNameAndPath)
    Next i

    MsgBox InputFileType & " files in " & InputDirPath & " have been merged together." & vbNewLine _
        & "You can find the output file " & OutputFileName & " in this location:" & vbNewLine _
        & OutputDirPath

    Stream.Close


ExitRoutine:
    Set FSO = Nothing
    Set FileToCopy = Nothing
    Set StreamToCopy = Nothing
    If Not Stream Is Nothing Then
        Stream.Close
    End If
    Set Stream = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "Hey mate, something went wrong, call me and tell me this" & vbNewLine & _
           "Method name: " & SOURCE & vbNewLine & _
           "Error code: " & Err.Number & vbNewLine & _
           "Error description: " & Err.Description, vbExclamation, "Unexpected error at " & SOURCE
    GoTo ExitRoutine

End Sub
\$\endgroup\$
  • 3
    \$\begingroup\$ Awesome first post! Welcome aboard! (hope you stick around ;) \$\endgroup\$ – Mathieu Guindon Mar 26 '15 at 21:55
  • 1
    \$\begingroup\$ Great review, but why not use Excel's built in FileDialog? \$\endgroup\$ – RubberDuck Mar 26 '15 at 22:41
  • \$\begingroup\$ On the *.ack vs. .ack I broke it down that way because they are FSO functions vs. string functions, but I'll give that a try and see how it goes! \$\endgroup\$ – Phrancis Mar 26 '15 at 23:32
  • 1
    \$\begingroup\$ @RubberDuck Good point. I totally forgot about it. So Phrancis you can use this instead of the heavy code I sent Sub UseFileDialogOpen() Dim lngCount As Long ' Open the file dialog With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .InitialFileName = "C:\Users\fveilleux-gaboury\Documents" .Show ' Display paths of each file selected For lngCount = 1 To .SelectedItems.Count MsgBox .SelectedItems(lngCount) Next lngCount End With End Sub \$\endgroup\$ – PetLahev Mar 27 '15 at 14:42
  • \$\begingroup\$ @PetLahev You probably should edit that into your answer so the formatting and everything looks right :) \$\endgroup\$ – Phrancis Mar 27 '15 at 15:14
1
\$\begingroup\$

This is a smart little piece of code and would be worth extracting into it's own function.

If Right(FromPath, 1) <> "\" Then
    FromPath = FromPath & "\"
End If

Except, you really shouldn't have to do this in order to build a file path. The FileSystemObject has a function that appends strings together as filepaths. If you used it instead of concatenation, you wouldn't have to worry about those pesky slashes. For example, both of these statements will print the exact same string.

Dim fso As New FileSystemObject
Debug.Print fso.BuildPath("C:\Users\", "foobar")
' => C:\Users\foobar
Debug.Print fso.BuildPath("C:\Users", "foobar")
' => C:\Users\foobar

I'm going to second @PetLahev's point about creating a GUI for your co-workers to use and officially recommend using the Application.FileDialog in your code. That would make all of the code verifying that a directory exists obsolete, because it had to have existed in order for them to have selected it.

So now, this snippet

Dim InputFileType As String
InputFileType = "*.txt"
Dim InputFileName As String
InputFileName = Dir$(InputDirPath & InputFileType)
Dim FileArray() As String
Dim i As Integer: i = 0

Do Until InputFileName = vbNullString
    ReDim Preserve FileArray(0 To i)
    FileArray(i) = InputFileName
    InputFileName = Dir$
    i = i + 1
Loop

Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

I don't like that you're using a FileSystemObject and the built in Dir$ function. You're using two different paradigms for manipulating the file system. I would use just one or the other. Personally, I like the extra power and simplicity of the FSO.

Also, I don't see a reason to put all of the file names in an array and then loop a second time to process the files. Just loop over the files in the directory directly the way you did here.

For Each File In Folder.Files
    If InStr(1, File.Name, OldText) <> 0 Then
        FileName = Replace(File.Name, OldText, NewText)
        File.Name = FileName
    End If
Next

Finally, I noticed this

Dim FileToCopy As File

and this

Dim fso As Object
Dim Folder As Object

The prior means that you added a reference to the Scripting Runtime, yet you've declared fso and Folder as Object types. The latter declaration should really be strong typed and look like this.

Dim fso As FileSystemObject
Dim fldr As Folder

To go along with that, I also wouldn't use the CreateObject("Scripting.FileSystemObject") call either. Just create your fso with the New keyword.

Set fso = New FileSystemObject
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.