Prompt user to select all the semicolon-delimited files they would like to convert into XLS files

convert_semicolon_text_to_xls.vb

Option Explicit
Public Sub ConvertSemicolonTextToXLS()
    
    Dim fdoUserPicks As FileDialog
    Dim strMessage As String, strFilename As String
    Dim wbkData As Workbook
    Dim lngIdx As Long
    
    'Leverage the already-written-for-you PromptUserToSelectFiles
    'function from the VBA Toolbelt to prompt the user to select files
    '
    'http://danwagner.co/vba-toolbelt/
    strMessage = "Please select the target semicolon-delimited TXT files"
    Set fdoUserPicks = PromptUserToSelectFiles(True, strMessage, "TXT")
    
    'Guard clause: exit if user clicks cancel
    If fdoUserPicks Is Nothing Then Exit Sub
    
    'Loop through each selected file
    For lngIdx = 1 To fdoUserPicks.SelectedItems.Count
    
        'Open the text file and set a reference to the workbook
        'and active worksheet (since it's a text file, the active sheet
        'will be the ONLY sheet)
        Workbooks.OpenText fdoUserPicks.SelectedItems(lngIdx), _
                           Semicolon:=True
        Set wbkData = ActiveWorkbook
        
        'Create a filename for the new file (that removes .txt)
        strFilename = Left(wbkData.Name, Len(wbkData.Name) - 4)
        
        'Save the workbook as an XLS file using 56 (which is xlExcel8)
        'instead of xlExcel8 as Excel 2003 does not understand xlExcel8
        wbkData.SaveAs Filename:=strFilename, FileFormat:=56
        wbkData.Close SaveChanges:=False
        
    Next lngIdx
    
    MsgBox "Converted all files!"
    
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : AllowMultiples, True or False (if you'd like to allow multi-
'            : select or not), TargetFileType, the string representation of the
'            : filetypes tha will be contained in the output. The following is
'            : a list of the supported types -- "XLSX", "XLSB", "XLSM", "XLS",
'            : "CSV", "TXT", and "ALL". DisplayText, the string that will be
'            : appear to the user on the file window.
'OUTPUT      : FileDialog, containing the selected file(s)
'SPECIAL CASE: if user selects cancel, FileDialog will be Nothing
Public Function PromptUserToSelectFiles(AllowMultiples As Boolean, _
                                        DisplayText As String, _
                                        TargetFileType As String) As FileDialog
    Dim fdo As FileDialog
    If StrComp(TargetFileType, "XLSX", vbTextCompare) = 0 Then
        Set fdo = Application.FileDialog(msoFileDialogOpen)
        With fdo
            .AllowMultiSelect = AllowMultiples
            .Title = DisplayText
            .ButtonName = ""
            .Filters.Clear
            .Filters.Add ".xlsx files", "*.xlsx"
            .Show
        End With
    ElseIf StrComp(TargetFileType, "XLSB", vbTextCompare) = 0 Then
        Set fdo = Application.FileDialog(msoFileDialogOpen)
        With fdo
            .AllowMultiSelect = AllowMultiples
            .Title = DisplayText
            .ButtonName = ""
            .Filters.Clear
            .Filters.Add ".xlsb files", "*.xlsb"
            .Show
        End With
    ElseIf StrComp(TargetFileType, "XLSM", vbTextCompare) = 0 Then
        Set fdo = Application.FileDialog(msoFileDialogOpen)
        With fdo
            .AllowMultiSelect = AllowMultiples
            .Title = DisplayText
            .ButtonName = ""
            .Filters.Clear
            .Filters.Add ".xlsm files", "*.xlsm"
            .Show
        End With
    ElseIf StrComp(TargetFileType, "XLS", vbTextCompare) = 0 Then
        Set fdo = Application.FileDialog(msoFileDialogOpen)
        With fdo
            .AllowMultiSelect = AllowMultiples
            .Title = DisplayText
            .ButtonName = ""
            .Filters.Clear
            .Filters.Add ".xls files", "*.xls"
            .Show
        End With
    ElseIf StrComp(TargetFileType, "CSV", vbTextCompare) = 0 Then
        Set fdo = Application.FileDialog(msoFileDialogOpen)
        With fdo
            .AllowMultiSelect = AllowMultiples
            .Title = DisplayText
            .ButtonName = ""
            .Filters.Clear
            .Filters.Add ".csv files", "*.csv"
            .Show
        End With
    ElseIf StrComp(TargetFileType, "TXT", vbTextCompare) = 0 Then
        Set fdo = Application.FileDialog(msoFileDialogOpen)
        With fdo
            .AllowMultiSelect = AllowMultiples
            .Title = DisplayText
            .ButtonName = ""
            .Filters.Clear
            .Filters.Add ".txt files", "*.txt"
            .Show
        End With
    ElseIf StrComp(TargetFileType, "ALL", vbTextCompare) = 0 Then
        Set fdo = Application.FileDialog(msoFileDialogOpen)
        With fdo
            .AllowMultiSelect = AllowMultiples
            .Title = DisplayText
            .ButtonName = ""
            .Filters.Clear
            .Filters.Add ".xlsx files", "*.xlsx"
            .Filters.Add ".xlsb files", "*.xlsb"
            .Filters.Add ".xlsm files", "*.xlsm"
            .Filters.Add ".xls files", "*.xls"
            .Filters.Add ".csv files", "*.csv"
            .Filters.Add ".txt files", "*.txt"
            .Show
        End With
    Else
        Set PromptUserToSelectFiles = Nothing
        Exit Function
    End If
    If fdo.SelectedItems.Count = 0 Then
        Set PromptUserToSelectFiles = Nothing
    Else
        Set PromptUserToSelectFiles = fdo
    End If
End Function