Добавление имени файла при импорте txt-файла в VBA

Question

Я просто написал программу, которая импортирует TXT-файлы в excel.

Я пытаюсь импортировать имя файла (custName) в первую строку листа и .txt, чтобы начать с этого ниже. Мое имя файла импортируется, отставая от 2-х столбцов за соответствующим .txt-файлом, и первое импортированное имя файла всегда отсутствует.

Я пропустил какое-то смещение или это что-то с тем, как работает первый цикл 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 до B1, в то время как вы пишете имя файла в A1 ранее. Это должно привести к отсутствию двух имен файлов, а третье - в ячейке A1.

Answer 2

Я пробовал использовать счетчик для смещения ваших имен файлов от 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