在VBA中导入txt文件时添加文件名

Question

我刚刚编写了一个将.txt文件导入excel的程序。

我尝试将文件名（custName）导入到工作表的第一行，然后从.txt开始。我的文件名在相关的.txt文件后面导入了2列，并且始终缺少第一个导入的文件名。

我是否错过了某种偏移或是第一个for循环如何运行？

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

Answer 1

我尝试使用计数器来偏移A1的文件名并从A2查询，但它运行正常。

请注意，您可以将通配符与DIR一起使用（请参阅Loop through files in a folder using VBA?），而不是使用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

Answer 2

好吧，在最后你删除了单元格A1到B1，而你早先将文件名写入A1。这会导致两个文件名丢失，第三个文件以A1格式结束。