VBA:将多个csv文件导入到现有表中

时间:2018-08-09 13:37:10

标签: excel vba excel-2016

我想在现有表格的底部导入多个csv文件。但是,在导入文件时,它总是排除每个文件列表的第一行。列表的第一行与电子表格的第一行有所不同,因为在它们之间还有其他不需要的行(例如标题,空行...)。恢复:如果我上传了5个文件,则会错过5个文件中每个文件的第一行。

这是代码:

Private Sub Import_auction_offers_Click()
    Dim strSourcePath As String
    Dim strFile As String
    Dim Cnt As Long

    'Change the path to the source folder accordingly
    strSourcePath = "C:\Users\L18944\Desktop\example"

    If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
    strFile = Dir(strSourcePath & "*.csv")

    Do While Len(strFile) > 0
        Cnt = Cnt + 1

Open strSourcePath & strFile For Input As #1

If Range("F2").Value <> "" Then
    Range("F1").End(xlDown).offset(1, 0).Select
Else:
    Range("F1:F" & Range("F" & Rows.Count).End(xlUp).Row).offset(1, 0).Select
End If
currentRow = 0
rowNumber = 0

'EOF(1) checks for the end of a file
Do Until EOF(1)
    Line Input #1, lineFromFile
    fileStr = Split(lineFromFile, vbLf)
    Dim item As Variant
    For Each item In fileStr
    'For item = LBound(fileStr) To UBound(fileStr)
        lineitems = Split(item, ";")
        'Debug.Print (item)
        If rowNumber = 1 Then
            startDate = lineitems(6)
        End If
        If rowNumber > 3 And item <> "" Then
            If Not doesOfferExist(CStr(lineitems(2))) Then
                ActiveCell.offset(currentRow, 0) = startDate
                ActiveCell.offset(currentRow, 1) = lineitems(4)
                ActiveCell.offset(currentRow, 2) = lineitems(3)
                ActiveCell.offset(currentRow, 3) = CDbl(lineitems(6))
                ActiveCell.offset(currentRow, 4) = CDbl(lineitems(7))
                ActiveCell.offset(currentRow, 5) = lineitems(8)
                ActiveCell.offset(currentRow, 6) = lineitems(1)
                ActiveCell.offset(currentRow, 7) = lineitems(2)
                ActiveCell.offset(currentRow, 8) = "New"
                currentRow = currentRow + 1
            End If
        End If

        rowNumber = rowNumber + 1
    Next item
Loop
Close #1
 Name strSourcePath & strFile As strSourcePath & strFile
        strFile = Dir
    Loop

  Application.ScreenUpdating = True

    If Cnt = 0 Then _
        MsgBox "No CSV files were found...", vbExclamation

End Sub

有人知道为什么它会丢失每个导入列表的第一行吗? 预先谢谢你

1 个答案:

答案 0 :(得分:1)

我没有通过您的ImportAuctionOffers代码,但是我假设您正在为每个文件找到新的起始行。

此代码将使您可以选择文件(并设置初始目录)。然后遍历所有选定项,为每个文件调用ImportAuctionOffers过程。

Sub test()
    Dim oFileDialog As FileDialog

    Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    oFileDialog.AllowMultiSelect = True
    oFileDialog.InitialFileName = "C:\Temp"    ' can set your default directory here

    oFileDialog.Show

    Dim iCount As Integer
    For iCount = 1 To oFileDialog.SelectedItems.Count
        Call ImportAuctionOffers(oFileDialog.SelectedItems(iCount))
    Next

End Sub

更新:

对于第二个问题:由于带有RowNumber的if语句,可能无法读取第一条数据行。

rowNumber=0

Do ...
    if RowNumber = 1 Then ...
    if RowNumber > 3 ...

    RowNumber = RowNumber + 1
loop

当RowNumber等于0、2或3时,您的代码将不会输入任何if语句。您可能只需要将> 3更改为> 2或> =3。