Run Complicated Macro on Many Files-CodePudding

I have a large list of .txt files that I need to have a macro that does the following:

Open Files
Delimit the file based on "|"
Select all then filter
Sort on a specific header

Steps 3 and 4 are easy... If these files weren't all .txt with | delimiters, I know how to open multiple files and then filter/sort, the issue I run into is step 2.

Code so far:

Option Explicit
Dim theDir As String, wk As Workbook, numFiles As Integer, s As String, r As Range
Const ext = ".txt"


Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    theDir = ThisWorkbook.Path
    s = Dir(theDir & "\*" & ext)
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.txt*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
    Set r = Range(Range("A1"), Range("A1").End(xlDown))
    r.TextToColumns Destination:=r, DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:="|", _
    FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array( _
        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
    Application.DisplayAlerts = False
    s = Dir()
    numFiles = numFiles   1
        
            xFileName = Dir
            End With
        Loop
    End If
End Sub

This code works... but only for the first column, I have upwards of 70 columns in some documents.

CodePudding user response：

You could use the Workbooks.OpenText method - a bit easier to manage I think

Sub Tester()

    Dim wb As Workbook
    
    Set wb = GetWorkbook("C:\Temp\pipes.txt")
    
    Debug.Print wb.Name

End Sub


Function GetWorkbook(fpath) As Workbook
    Workbooks.OpenText Filename:=fpath, Origin:=437, StartRow:= _
        1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="|", TrailingMinusNumbers:=True
    Set GetWorkbook = ActiveWorkbook
End Function

CodePudding user response：

You are selecting the first column in this line of code.

Set r = Range(Range("A1"), Range("A1").End(xlDown))

This should be OK if the files are text delimited by the pipe symbol. However if there are commas in the files, it will automatically break data after the comma into another column.

Try opening the files directly in text mode.

As an example

Workbooks.OpenText Filename:="C:\Temp\Test1.txt", _
    Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
    , Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
    TrailingMinusNumbers:=True

CodePudding user response：

I got this to work:

Option Explicit
Dim theDir As String, wk As Workbook, numFiles As Integer, s As String, r As Range
Const ext = ".txt"


Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    theDir = ThisWorkbook.Path
    Dim wkbpath As String
    Dim wkbname As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem) ' old version had: & "*.txt*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
                    Set r = Range(Range("A1"), Range("A1").End(xlDown))
                    r.TextToColumns Destination:=r, DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|", _
                    FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
                        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
                        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
                        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
                        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
                        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
                        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
                        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
                        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array( _
                        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
                    Application.DisplayAlerts = False
                    Cells.Select
                        Selection.AutoFilter
                        Application.AddCustomList ListArray:=Array("PREFERRED", "NON-PREFERRED", _
                            "UNACCEPTABLE", "OBSOLETE")
                        ActiveSheet.Sort.SortFields. _
                            Clear
                        ActiveSheet.Sort.SortFields. _
                            Add Key:=Range("D2:D479"), SortOn:=xlSortOnValues, _
                            CustomOrder:="PREFERRED,NON-PREFERRED,UNACCEPTABLE,OBSOLETE", DataOption:= _
                            xlSortNormal
                        With ActiveSheet.Sort
                            .SetRange Range("A1:BH79")
                            .Header = xlYes
                            .MatchCase = False
                            .Orientation = xlTopToBottom
                            .SortMethod = xlPinYin
                            .Apply

            xFileName = Dir
            
            wkbpath = "C:\Users\tomas.breitinger\Desktop\BAE Export .DAT Files\Finished\"
            wkbname = ActiveWorkbook.Name
            ActiveWorkbook.SaveAs Filename:= _
            wkbpath & wkbname & ".xlsx", FileFormat:=51, CreateBackup:=False
            ActiveWorkbook.Close savechanges:=False
            End With
              End With
        Loop
    End If
End Sub