Text File Import with Custom Delimiters

' Text File Import with Custom Delimiters
' Import multiple text files and convert to Excel with specific column splits

Sub ImportTextFiles()
    ' Import text files with custom delimiters
    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False

    ' Prompt for folder containing text files
    Dim folderPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Folder Containing Text Files"
        .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "No folder selected.", vbExclamation
            Exit Sub
        End If
        folderPath = .SelectedItems(1)
    End With

    If Right(folderPath, 1) <> "" Then folderPath = folderPath & ""

    ' Get list of text files to import
    Dim fileName As String
    Dim fileCount As Integer
    fileCount = 0

    fileName = Dir(folderPath & "*.txt")

    Do While fileName <> ""
        ' Import each file
        Call ImportSingleFile(folderPath & fileName)
        fileCount = fileCount + 1
        fileName = Dir()
    Loop

    Application.ScreenUpdating = True

    If fileCount = 0 Then
        MsgBox "No text files found in selected folder.", vbInformation
    Else
        MsgBox "Successfully imported " & fileCount & " file(s)!", vbInformation
    End If

    Exit Sub

ErrorHandler:
    Application.ScreenUpdating = True
    MsgBox "Error importing files: " & Err.Description, vbCritical
End Sub

Sub ImportSingleFile(filePath As String)
    ' Import a single text file with custom delimiter
    On Error GoTo ErrorHandler

    ' Prompt for delimiter specification
    Dim delimiter As String
    delimiter = InputBox("Enter delimiter for " & Dir(filePath) & vbCrLf & _
                       "Common options: comma (,), tab (TAB), pipe (|), semicolon (;)", _
                       "File Delimiter", ",")

    If delimiter = "" Then Exit Sub

    ' Convert TAB keyword to actual tab character
    If UCase(delimiter) = "TAB" Then delimiter = vbTab

    ' Prompt for column widths if fixed-width
    Dim useFixedWidth As Boolean
    Dim columnWidths As String

    Dim response As VbMsgBoxResult
    response = MsgBox("Is this a fixed-width file?", vbYesNo + vbQuestion)

    If response = vbYes Then
        useFixedWidth = True
        columnWidths = InputBox("Enter column widths separated by commas" & vbCrLf & _
                              "Example: 10,15,20,8", "Column Widths")
        If columnWidths = "" Then Exit Sub
    End If

    ' Create new workbook for imported data
    Dim newWB As Workbook
    Set newWB = Workbooks.Add

    Dim ws As Worksheet
    Set ws = newWB.Sheets(1)

    ' Read file and import data
    Dim fileNum As Integer
    fileNum = FreeFile

    Open filePath For Input As #fileNum

    Dim lineText As String
    Dim rowNum As Long
    rowNum = 1

    Do Until EOF(fileNum)
        Line Input #fileNum, lineText

        If useFixedWidth Then
            Call ParseFixedWidthLine(ws, rowNum, lineText, columnWidths)
        Else
            Call ParseDelimitedLine(ws, rowNum, lineText, delimiter)
        End If

        rowNum = rowNum + 1
    Loop

    Close #fileNum

    ' Format the worksheet
    ws.Columns.AutoFit
    ws.Rows(1).Font.Bold = True
    ws.Rows(1).Interior.Color = RGB(200, 230, 255)

    ' Save as Excel file
    Dim savePath As String
    savePath = Replace(filePath, ".txt", ".xlsx")

    newWB.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbook

    newWB.Close SaveChanges:=False

    Exit Sub

ErrorHandler:
    If fileNum > 0 Then Close #fileNum
    MsgBox "Error importing file: " & Err.Description, vbCritical
End Sub

Sub ParseDelimitedLine(ws As Worksheet, rowNum As Long, lineText As String, delimiter As String)
    ' Parse delimited line into columns
    Dim values() As String
    values = Split(lineText, delimiter)

    Dim colNum As Long
    For colNum = LBound(values) To UBound(values)
        ws.Cells(rowNum, colNum + 1).Value = Trim(values(colNum))
    Next colNum
End Sub

Sub ParseFixedWidthLine(ws As Worksheet, rowNum As Long, lineText As String, columnWidths As String)
    ' Parse fixed-width line into columns based on specified widths
    Dim widths() As String
    widths = Split(columnWidths, ",")

    Dim colNum As Long
    Dim startPos As Long
    startPos = 1

    For colNum = LBound(widths) To UBound(widths)
        Dim width As Long
        width = CLng(Trim(widths(colNum)))

        If startPos <= Len(lineText) Then
            Dim value As String
            value = Mid(lineText, startPos, width)
            ws.Cells(rowNum, colNum + 1).Value = Trim(value)
        End If

        startPos = startPos + width
    Next colNum
End Sub

Sub ImportSingleFileWithDialog()
    ' Import a single file with file picker dialog
    On Error GoTo ErrorHandler

    Dim filePath As String

    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select Text File to Import"
        .Filters.Clear
        .Filters.Add "Text Files", "*.txt;*.csv"
        .Filters.Add "All Files", "*.*"
        .Show

        If .SelectedItems.Count = 0 Then
            MsgBox "No file selected.", vbExclamation
            Exit Sub
        End If

        filePath = .SelectedItems(1)
    End With

    Call ImportSingleFile(filePath)

    Exit Sub

ErrorHandler:
    MsgBox "Error: " & Err.Description, vbCritical
End Sub