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

我刚刚编写了一个程序，该程序可以将.txt文件导入到excel中。在VBA中导入txt文件时添加文件名

我尝试将文件名（custName）导入到工作表的第一行，然后在下面开始.txt。我的文件名被导入滞后于相关联的.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

来源

2015-04-20 Rikard M Norén

-1

那么，在最后你删除单元格A1到B1，而你先前写入A1的文件名。这应该导致两个文件名丢失，第三个文件以单元格A1结尾。

来源

2015-04-20 07:56:14 Verzweifler

这可能看起来像这个问题，但acctually的程序将最后在表中的第一项。删除的单元格是空的，这就是为什么我删除它们。所以这不是问题的起因。 –

您正在为每个文件在同一列中编写标题和数据。如果您从其中一行中删除单元格，则此**必须**创建一个偏移量。我想你应该看看为什么这两个单元格是空的（并且如果你不删除它们，测试偏移量是否仍然存在）。 – Verzweifler

我试着用一个计数器来抵消你的文件名从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

来源

2015-04-23 07:56:37 brettdj

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

回答

相关问题