Question

我正在尝试使用msoFileDialogFolderPicker选择一个文件夹，然后循环浏览该文件夹。如果我将Do While Len(myFile) > 0指定为FolderPicker，似乎无法让filepath用C:\Test\来触发，它工作得很好。

Option Explicit

Sub LoopThroughDirectory()

    Dim myFile As String, filepath As String
    Dim wbc As Long, ws As Worksheet, wb As Workbook
    Dim diaFolder As FileDialog

Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False

If diaFolder.Show = -1 Then
    myFile = diaFolder.SelectedItems(1)
End If

    wbc = 0
    filepath = diaFolder

   Application.ScreenUpdating = False

   'Only try to open xlsm workbooks
    myFile = Dir(filepath & "*.xlsm*")

    Do While Len(myFile) > 0
        'Make sure myFile isn't ThisWorkbook
        If Split(myFile & ".", ".")(0) <> Split(ThisWorkbook.Name & ".", ".")(0) Then

            Set wb = Workbooks.Open(Filename:=filepath & myFile, ReadOnly:=True)

            'Check if there is a Results worksheet
            On Error Resume Next
            Set ws = wb.Worksheets("Results")
            On Error GoTo 0
            If Not ws Is Nothing Then
                 'Transfer cells B2 & C2 from the results worksheet
                 With ws.Range("A2:B2")
                     ThisWorkbook.Worksheets("AMT").Range("B4").Offset(wbc, 0).Resize(.Rows.Count, .Columns.Count) = .Value
                 End With
            End If

            'Close wb most recently opened
            wb.Close SaveChanges:=False

            wbc = wbc + 1
            If wbc > 1000 Then Exit Do

        End If

        Set ws = Nothing
        myFile = Dir
    Loop

    ActiveWorkbook.Save

End Sub

Answer 1

它不起作用的原因是因为您将myFile分配给了错误的变量：

您的代码：

filepath = diaFolder

正确的代码：

filepath = myFile

加

myFile = Dir(filepath & "*.xlsm*")

应该是

myFile = Dir(filepath & "\*.xlsm")

做While循环不触发

1 个答案: