Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Prompt user to select all the semicolon-delimited files they would like to convert into XLS files
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.