Excel VBA Import Text Array Definition problem

Question

I have a workbook with 30 tabs of data that all follow the same process:

1. Go to a tab in the template workbook
2. Use the Data Import routine to spit out a CSV's data, dumping values on line 7 to start.
3. Delete line 7 when finished (it's useless headers we don't need)

The problem arises from the Import Text File routine, that needs an array for every single sheet. I end up with 40 lines of code for every sheet and no way to variablize the routine. Here's the first section of a 30-part sub (all have similar structure):

    'Use the Get Data routine to dump the csv onto the sheet as text/dates where appropriate, then delete line 7
Sheets("Sheet Alpha info").Select                 'explicitly declare which sheet to dump onto
Application.CutCopyMode = False                 'this is good programming

    'this code section is the Get Data routine run in the UI, turned into VBA
With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & ThisWorkbook.Path & "\sheet_alpha.CSV", _
    Destination:=Range("$A$7"))                 'important on every tab!
    '.CommandType = 0                           'this is only needed when you use the UI to do the routine, so currently commented out.
    .Name = "sheet_alpha"                       'could variablize this routine, but signficance of .Name is unknown in Import routine.
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437                     'no idea what this actually is. encoding for UTF-8?
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited            'not set width
    .TextFileTextQualifier = xlTextQualifierDoubleQuote              'yes, well-behaved CSV.
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True              'yes, well-behaved CSV.
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2) 'this damn array is why we repeat the code. Need a new array for each sheet.
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With

    'and now remove the useless header line
Rows("7:7").Select
Selection.Delete Shift:=xlUp

So question is: How can I variablize this routine and make it a single FOR loop that also defines each TextFileColumnDataType array as a text-only array (so, Array() filled with 2s each time)?

Extension: If I wanted the array to read other data types (so an array might be Array(1, 2, 2, 3, 2, 2, 2)), how do I do that?

Answer 1

There are really only 3 variables here: the source file, the destination range, and the array of field types.

You could wrap this code in a sub with those 3 parameters and it should work fine. The only challenge is determining the exact field types for each file (assuming that's important here)

Sub Tester()
    'eg - call directly
    ImportFromText ThisWorkbook.Sheets("test").Range("A7"), _
                    ThisWorkbook.Path & "\test.csv", _
                    Array(2, 2, 2, 2, 2, 2, 2, 2, 2)

    '...or from a worksheet table
    Dim rw As Range
    For Each rw in ThisWorkbook.Sheets("Files").Range("A2:C32").Rows 

        ImportFromText ThisWorkbook.Sheets(rw.Cells(1).Value).Range("A7"), _
                    ThisWorkbook.Path & "\" & rw.Cells(2).Value, _
                    Split(rw.Cells(3).Value, "|")

    Next rw


End Sub


Sub ImportFromText(DestRange As Range, filePath As String, arrFieldTypes)

    Dim sht As Worksheet, qt As QueryTable

    Set sht = DestRange.Worksheet

    'clear any previous....
    Do While sht.QueryTables.Count > 0
        sht.QueryTables(1).Delete
    Loop
    sht.UsedRange.Clear

    Set qt = sht.QueryTables.Add(Connection:="TEXT;" & filePath, Destination:=DestRange)

    With qt
        '.CommandType = 0
        .Name = "sheet_alpha"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = arrFieldTypes
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    DestRange.EntireRow.Delete Shift:=xlUp 'and now remove the useless header line

End Sub