Excel VBA Import Text Array Definition problem - excel

Question

I have a workbook with 30 tabs of data that all follow the same process:
Go to a tab in the template workbook
Use the Data Import routine to spit out a CSV's data, dumping values on line 7 to start.
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