将导入的CSV的每个记录中的文件名附加到excel中

时间:2014-07-16 00:32:54

标签: excel-vba csv vba excel

我编写了以下宏,它从Active Excel电子表格所在的目录中导入所有CSV文件。现在我想在每个记录的最后一列中附加CSV的相应文件名,但我无法弄清楚如何执行此操作。任何人都可以给我一个指针。

Sub ImportAllCSV()
  Dim FName As Variant, R As Long
  R = 1
  FName = Dir("*.csv")
  Dim counter As Integer, startRow As Integer
  counter = 0
  Do While FName <> ""
    If counter = 0 Then
      startRow = 3
    Else
      startRow = 4
    End If
    load_csv FName, ThisWorkbook.Sheets("Indata").Cells(R, 1), startRow
    R = ThisWorkbook.Sheets("Indata").UsedRange.Rows.Count + 1
    FName = Dir
    counter = counter + 1
  Loop

End Sub

Sub load_csv(fStr As Variant, Position As Range, startRow As Integer)
    With ThisWorkbook.Sheets("Indata").QueryTables.Add(Connection:= _
    "TEXT;" & fStr, Destination:=Position)
        .Name = "CAPTURE"
        .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 = startRow
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .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)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False

    End With
End Sub

1 个答案:

答案 0 :(得分:0)

使用load_csv功能,您只需导入csv,但您可以执行更多操作(例如在任何地方编写文件名)...还要考虑导入时,您必须说文件你必须选择。这导致了一个简单的想法:文件名应该已经在你的函数中的某个地方!

提示:fStr

我还建议只保留导入所需的命令......这些命令似乎用Excel宏记录器记录下来,其中一些可能没有任何帮助。