Adding filename while importing txt file in VBA

Question

I just wrote a program that imports .txt files to excel.

I try to import the filename (custName) to the first row of the sheet and the .txt to start below that. My filename is imported lagging 2 columns behind the associated .txt file and the first imported filename is always missing.

Am I missing some sort of offset or is it something with how the first for loop is running?

Function import(shtraw)

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
    .Show
    .AllowMultiSelect = False
    If .SelectedItems.Count = 0 Then
        MsgBox "You did not select a folder"
        Exit Function
    End If
    MyFolder = .SelectedItems(1)
End With

Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
Set folderObj = fileSystemObject.getfolder(MyFolder)

shtraw.Select
For Each fileObj In folderObj.Files 'loop through files

If (fileSystemObject.GetExtensionName(fileObj.Path) = "txt") Then

    If Not fileObj.Attributes And 2 Then
        arrFileName = Split(fileObj.Path, "\")
        Path = "TEXT:" & fileObj.Path
        filename = arrFileName(UBound(arrFileName))

        'Get the filename without the.mtmd
        CustName = Mid(filename, 1, InStr(filename, ".") - 1)
        shtraw.range("$A$1").value = CustName

        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fileObj.Path, Destination:=range("$A$2"))
            .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 = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    End If 'end if hidden if statement
    End If 'end of txt
Next fileObj 'close loop

range("$A$1:$B$1").Delete shift:=xlToLeft

End Function

score 0 · Answer 1 · edited May 23 '17 at 12:28

I tried using a counter to offset your file names from A1 and query from A2 and it worked fine.

Note that you can use wildcards with DIR (see Loop through files in a folder using VBA?) rather than test each file using the FileScriptingObject

Function import(shtraw)

Dim lngCnt As Long

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder"
    .Show
    .AllowMultiSelect = False
    If .SelectedItems.Count = 0 Then
        MsgBox "You did not select a folder"
        Exit Function
    End If
    MyFolder = .SelectedItems(1)
End With

Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
Set folderObj = fileSystemObject.getfolder(MyFolder)

shtraw.Select
For Each fileObj In folderObj.Files 'loop through files

If (fileSystemObject.GetExtensionName(fileObj.Path) = "txt") Then

    If Not fileObj.Attributes And 2 Then
        arrFileName = Split(fileObj.Path, "\")
        Path = "TEXT:" & fileObj.Path
        Filename = arrFileName(UBound(arrFileName))

        'Get the filename without the.mtmd
        CustName = Mid(Filename, 1, InStr(Filename, ".") - 1)
        shtraw.Range("$A$1").Offset(0, lngCnt).Value = CustName

        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fileObj.Path, Destination:=Range("$A$2").Offset(0, lngCnt))
            .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 = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        lngCnt = lngCnt + 1
    End If 'end if hidden if statement
    End If 'end of txt
Next fileObj 'close loop

End Function

score -1 · Answer 2 · answered Apr 20 '15 at 07:56

-1

Well, at the very end you delete the Cells A1 to B1, whereas you write the filename into A1 earlier. This should result in two filenames missing and the 3rd ending up in cell A1.

answered Apr 20 '15 at 07:56

Verzweifler

930
6
16

This might look like the problem but acctually the program puts the first entry last in the sheet. The deleted cells are empty, thats why i delete them. So this is not where the problem originates. – Rikard M Norén Apr 22 '15 at 13:40
You are writing Title and Data in the same column for each file. If you then delete Cells from only one of the rows, this **has to** create an offset. I think you should look into why those two cells are empty (and test if the offset still exists if you don't delete them). – Verzweifler Apr 23 '15 at 08:15

Adding filename while importing txt file in VBA

2 Answers2