HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Text files: Copy, Rename, Append/Merge together

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
codereviewarraystackoverflowbeginnerfile-systemvbastrings
mergetexttogethercopyfilesappendrename

Problem

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 St

Solution

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

  • 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.

  • 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" (lpBrow

Code Snippets

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
If FSO.FolderExists(FromPath) = False Then
   MsgBox "Source folder " & FromPath & " doesn't exist"
   Exit Sub
 End If
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
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))
         GetFol
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)

Context

StackExchange Code Review Q#85099, answer score: 5

Revisions (0)

No revisions yet.