导入多个CSV文件，同时为每个导入的文件添加文件名

Question

我一直在尝试导入多个CSV文件，每个文件都有一个唯一的名称。我想做的是：添加一列，文件名一直填充到每个导入文件的结尾。

Sub ImportMultipleCSV()

Dim myfiles
Dim i As Integer
Dim j As Integer
Dim Answer

myfiles = Application.GetOpenFilename(filefilter:="CSV Files (*.csv), *.csv", MultiSelect:=True)


    If IsArray(myfiles) Then
    Answer = MsgBox("Delete Files after Import?", vbYesNo + vbQuestion)
        For i = LBound(myfiles) To UBound(myfiles)
            With ActiveSheet.QueryTables.Add(Connection:= _
                "TEXT;" & myfiles(i), Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1, 0))
                .RefreshStyle = xlOverwriteCells
                .AdjustColumnWidth = True
                .TextFileStartRow = 2
                .TextFileParseType = xlDelimited
                .TextFileCommaDelimiter = True
                .Refresh

              'add file name to Seperate column

             Range("A" & Rows.Count).End(xlUp).Offset(0, 7).Value = myfiles(i)
**^^ this line only adds the file name, but I want to fill down.**


            End With

            If Answer = vbYes Then
                Kill myfiles(i)
            End If
        Next i

    Else
        MsgBox "No File Selected"
    End If


Dim xConnect As Object
    For Each xConnect In ActiveWorkbook.Connections
        If xConnect.Name <> "ThisWorkbookDataModel" Then xConnect.Delete
    Next xConnect


'Range("C:C,E:E,G:G").Delete


End Sub

这是我要实现的输出文件。

感谢您的帮助。非常感谢！

Answer 1

更改此：

Range("A" & Rows.Count).End(xlUp).Offset(0, 7).Value = myfiles(i)

对此：

Range(Range("H" & Rows.Count).End(xlUp).Offset(1), Range("A" & Rows.Count).End(xlUp).Offset(0,7)).Value = myFiles(i)