CODEWITHSUNDEEP
excelvbaimporttext-files
Stijn
Stijn

Reputation: 45

Visual Basic: Importing multiple textfiles into multiple sheets

All data is stored in text files. I have multiple of these files and I want to import each in a new sheet that bears the name of the file.

I recorded a macro so that it imports the data to the correct specifications. Afterwards, I added the part where it repeats this process for every file in the directory.

The result of my code is that it creates a new sheet with the correct name for each file, but the sheets are empty.

Sub ImportTextfiles()
    Dim folderName As String, filePathName As String, FileName As String

    folderName = "C:\Users\MyName\Documents\MultipleFiles\"
    FileName = Dir(folderName, vbNormal)

    While FileName <> ""
        filePathName = folderName & FileName
        Sheets.Add.Name = FileName
        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & filePathName, _
            Destination:=Range("$A$1"))
            .Name = FileName
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 1251
            .TextFileStartRow = 1
            .TextFileParseType = xlFixedWidth
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileFixedColumnWidths = Array(37, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, _
        10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, _
        10, 10, 10, 10, 10)
            .TextFileDecimalSeparator = "."
            .TextFileThousandsSeparator = ","
        End With
        FileName = Dir()
    Wend

End Sub

Upvotes: 0

Views: 154

Answers (1)

PeterT
PeterT

Reputation: 8557

You were very close. Recording macros is an excellent way to start learning to script your own custom functions. In this case, you were not using the new worksheet you were adding. So add the new sheet, correctly name it, then use that sheet to import the data.

Option Explicit

Sub ExtDataToSheets()
    Dim fnames() As String
    Dim fname As Variant
    Dim fullpath As String
    Dim newSh As Worksheet

    fnames = Split("file1.txt,file2.txt,file3.txt", ",")

    For Each fname In fnames
        fullpath = Application.Path & fname
        Set newSh = ActiveWorkbook.Sheets.Add
        newSh.Name = fname
        With newSh.QueryTables.Add(Connection:="TEXT;C:\Temp\SampleData.csv", _
            Destination:=Range("$A$1"))
            .Name = "SampleData"
            .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 = Array(1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    Next fname
End Sub

Upvotes: 1

Related Questions