Question

我正在使用下面的宏从excel工作表上的特定目录（C：\ csv）导入和排列所有.csv文件的内容。我希望宏也导入子目录中的所有.csv文件。如果浏览器窗口可以打开并让我选择我要导入的所有.csv文件的路径，那将是非常棒的。提前谢谢！

Dim wbCSV   As Workbook
Dim wsMstr  As Worksheet:   Set wsMstr = Sheet1
Dim fPath   As String:      fPath = "C:\csv\"    'path to CSV files
Dim fCSV    As String

If MsgBox("Clear the existing MasterCSV sheet before importing?", vbYesNo, "Clear?") _
    = vbYes Then wsMstr.UsedRange.Clear

Application.ScreenUpdating = False  'speed up macro

fCSV = Dir(fPath & "*.csv")         'start the CSV file listing

    Do While Len(fCSV) > 0
      'open a CSV file
        Set wbCSV = Workbooks.Open(fPath & fCSV)
      'insert col A and add filename
        Columns(1).insert xlShiftToRight
        Columns(1).insert xlShiftToRight
        Columns(1).insert xlShiftToRight
        Columns(1).insert xlShiftToRight
        Range("E4").Select
        Selection.Copy
        Range("a20:a87").Select
        ActiveSheet.Paste
      'copy date to b column
        Range("E3").Select
        Selection.Copy
        Range("b20:b87").Select
        ActiveSheet.Paste
      'copy sample to c column
        Range("c20:c87").Select
        ActiveCell = "sample"
        Range("c20").Select
        Selection.Copy
        Range("c21:c87").Select
        ActiveSheet.Paste
        'copy 1 to d column
        Range("d20:d87").Select
        ActiveCell = "1"
        Range("d20").Select
        Selection.Copy
        Range("d21:d87").Select
        ActiveSheet.Paste
        'delete header
        Rows("1:20").Select
        Selection.Delete Shift:=xlUp
        'delete un needed columns
        Columns("H:H").Select
        Selection.Delete Shift:=xlToLeft
        Columns("F:F").Select
        Selection.Delete Shift:=xlToLeft
        'copy date into master sheet and close source file
        ActiveSheet.UsedRange.Copy wsMstr.Range("A" & Rows.Count).End(xlUp).Offset(1)
        wbCSV.Close False
      'ready next CSV
        fCSV = Dir
    Loop

Application.ScreenUpdating = True

End Sub

Answer 1

Sub lookInSubfolders()
Dim sourceFolder as Scripting.Folder
Dim subfolder as Folder
  For Each subfolder in sourceFolder.SubFolders
    'Do stuff
  Next subfolder
End Sub

Sub getFiles()
    Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$
        'InitialFoldr$ = "\\path to default directory if you have a main folder"
        'This part opens up the browser window:
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = Application.DefaultFilePath & "\"
            .Title = "Please select a folder to list Files from"
            .InitialFileName = InitialFoldr$
            .Show

        'Optional for if there are no files in the directory
            If .SelectedItems.Count <> 0 Then
                xDirect$ = .SelectedItems(1) & "\"
                xFname$ = Dir(xDirect$, 7)
            If xFname$ = "" Then
                 MsgBox ("The folder is empty! Your work is done!")
                Exit Sub
            End If

        'Optional to list file names in column "A"
            Do While xFname$ <> ""
                ActiveCell.Offset(xRow) = xFname$
                xRow = xRow + 1
                xFname$ = Dir
            Loop
            End If
        End With
    End Sub

使用弹出浏览器在目录的所有子文件夹中import.csv文件

1 个答案: