使用VBA瀏覽多個.csv文件

Question

我正在嘗試制作一個可以瀏覽.csv文件的excel工作表，然后從該.csv文件復制並粘貼某些信息。 我對.csv文件一無所知，但在這種情況下，它們的外觀和作用類似於excel文件。

這是當前通過單個.csv文件查找的代碼（20180426IM-RV0K6OQH5MA2.csv）

Sub finder()

Worksheets("Sheet1").Range("A5:J200").Clear

'Use user deffined part number to locate the folder
Dim ParNum As String, FilePath As String, FileName As String
ParNum = Worksheets("Sheet1").Cells(2, "D").Value
FilePath = "R:\Series\Serial No. AC710121\" & ParNum & "\20180426IM-RV0K6OQH5MA2.csv"

'Declare Variables populated excel sheet
Dim Book As Workbook
Dim Brange As Range
Dim Bcell

Set Book = Workbooks.Open(FilePath)
Set Brange = Book.Sheets("20180426IM-RV0K6OQH5MA2").Range("A1:A200")

'Declare Variables for finder excel sheet
Dim Drange As Range
Dim Dcell

Set Drange = ThisWorkbook.Sheets("Sheet1").Range("D5:D205")

'Declare Variables for finder excel sheet
Dim Crange As Range
Dim Ccell

Set Crange = ThisWorkbook.Sheets("Sheet1").Range("C5:C205")

'For loop for printing in Finder
For Each Bcell In Brange

If Bcell.Value = "IT" Then
    Book.Sheets("20180426IM-RV0K6OQH5MA2").Range(Bcell.Offset(0, 2), Bcell.Offset(0, 8)).Copy

    For Each Dcell In Drange
        If IsEmpty(Dcell.Value) = True And IsEmpty(Dcell.Offset(0, -1).Value) = True Then

            ThisWorkbook.Sheets("Sheet1").Range(Dcell.Offset(0, 0), Dcell.Offset(0, 8)).PasteSpecial
        End If
     Next Dcell       
End If
Next Bcell


End Sub    

.csv文件是自動生成的，隨着時間的推移，該文件夾中將有多個.csv文件。 我希望代碼能夠打開一個.csv文件，執行其操作，然后打開下一個.csv文件，並重復進行直到找到文件夾中的所有.csv文件。

另外，是否有一種方法可以將變量聲明為正在瀏覽的文件的名稱，並使該文件中的工作表等於變量名？ 例如，如果文件名是“ Bob”，我想聲明一個變量“ Bob”，以便告訴代碼此工作簿中的工作表也稱為“ Bob”。

我希望這足夠清楚。 謝謝你的幫助！

Answer 1

這是執行我所正確詢問的代碼的代碼：

Sub finder()

Application.ScreenUpdating = False
Application.EnableEvents = False

Worksheets("Sheet1").Range("A5:J200").Clear

'Use user deffined part number to locate the file
Dim ParNum As String, FilePath As String, FileName As String
ParNum = Worksheets("Sheet1").Cells(2, "D").Value

'Variable that represents the file name
File = Dir("R:\Series\Serial No. AC710121\" & ParNum & "\*.csv")

'Looks through all the .csv files in the folder
Do While File <> ""

     'Variable that represents the name within the file
     SheetVar = Left(File, 23)
     'Variable that represents the file path to the file
     FilePath = "R:\Series\Serial No. AC710121\" & ParNum & "\" & File & ""

    'Declare Variables for populated excel sheet
    Dim Book As Workbook
    Dim Krange As Range
    Dim Kcell

    Set Book = Workbooks.Open(FilePath)
    Set Krange = Book.Sheets(SheetVar).Range("A1:A200")

    'Declare Variables for finder excel sheet (Column D)
    Dim Drange As Range
    Dim Dcell

    Set Drange = ThisWorkbook.Sheets("Sheet1").Range("D5:D205")

    'Declare Variables for finder excel sheet (Column C)
    Dim Crange As Range
    Dim Ccell

    Set Crange = ThisWorkbook.Sheets("Sheet1").Range("C5:C205")

    'For loop for copying the information and pasting it in Finder
    For Each Kcell In Krange

        If Kcell.Value = "IT" Then
            Book.Sheets(SheetVar).Range(Kcell.Offset(0, 2), Kcell.Offset(0, 8)).Copy

            For Each Dcell In Drange
                 If IsEmpty(Dcell.Value) = True And IsEmpty(Dcell.Offset(0, -1).Value) = True Then

                     ThisWorkbook.Sheets("Sheet1").Range(Dcell.Offset(0, 0), Dcell.Offset(0, 8)).PasteSpecial

                    If Dcell.Offset(0, 6).Value = "OK" Then
                        Range(Dcell.Offset(0, 0), Dcell.Offset(0, 6)).Interior.Color = RGB(113, 221, 131)
                    End If

                    If Dcell.Offset(0, 6).Value <> "OK" And IsEmpty(Dcell.Offset(0, 6).Value) = False Then
                        Range(Dcell.Offset(0, 0), Dcell.Offset(0, 6)).Interior.Color = RGB(221, 100, 120)
                    End If

                    Exit For

                 End If

            Next Dcell

        End If

        If Kcell.Value = "DA" Then
            Book.Sheets(SheetVar).Range(Kcell.Offset(0, 1), Kcell.Offset(0, 1)).Copy

            For Each Ccell In Crange
                If IsEmpty(Ccell.Value) = True And IsEmpty(Ccell.Offset(0, 1).Value) = True Then
                    ThisWorkbook.Sheets("Sheet1").Range(Ccell.Offset(0, 0), Ccell.Offset(0, 0)).PasteSpecial
                    Exit For
                End If
            Next Ccell

        End If

    Next Kcell

    Workbooks(File).Close SaveChanges = False

    File = Dir

Loop

Range("C2:J200").HorizontalAlignment = xlCenter
'Range("F5:F200").Sort Key1:=Range("F5"), Order1:=xlAscending, Header:=xlNo

End Sub

很抱歉，如果某些變量不同，但這應該能夠突出顯示我為使代碼執行所需操作而實現的更改。 我認為執行此任務還有更優雅的方法，這就是我想出的。

此代碼可以執行以下操作：

它使用用戶提供的部件號，然后使用該編號查找文件夾，然后瀏覽所述文件夾中的每個.csv文件。 它遍歷.csv文件並復制某些信息，然后將其粘貼到保存代碼的工作簿中。

希望這可以幫助某人。