Excel VBA循環幫助需要

Question

我需要這個宏來自動抓取列A中的數據，找到數據到給定的路徑中，並將其替換爲列B.它正在工作，但我需要它只工作一次，並繼續前自動.. 誰能幫我在這..

Sub UnkownFunctionName() 
    Dim myfolder 
    Dim Fnd As String, Rplc As String 

    Fnd = Application.InputBox(prompt:="Find string:", Title:="Rename files and folders", Type:=2) 
    Rplc = Application.InputBox(prompt:="Replace with:", Title:="Rename files and folders", Type:=2) 

    With Application.FileDialog(msoFileDialogFolderPicker) 
     .Show 
     myfolder = .SelectedItems(1) & "\" 
    End With 

    Call Recursive(myfolder, Fnd, Rplc) 

End Sub 

Sub Recursive(FolderPath As Variant, Fnd As String, Rplc As String) 

    Dim Value As String, Folders() As String, Fname As String, Fext As String, Mtxt As String 
    Dim x As Integer 
    Dim Folder As Variant, a As Long 

    ReDim Folders(0) 

    If Right(FolderPath, 2) = "\\" Then Exit Sub 

    Value = Dir(FolderPath, &H1F) 

    Do Until Value = "" 
     If Value = "." Or Value = ".." Then 
     Else 
      If GetAttr(FolderPath & Value) = 16 Or GetAttr(FolderPath & Value) = 48 Then 
       On Error Resume Next 
       Mtxt = "Rename folder " & Value & " to " & WorksheetFunction.Substitute(Value, Fnd, Rplc) & "?" 
       x = MsgBox(Mtxt, vbYesNoCancel) 

       If x = vbCancel Then Exit Sub 
       If x = vbYes Then 
        Name FolderPath & Value As FolderPath & WorksheetFunction.Substitute(Value, Fnd, Rplc) 
       End If 

       Value = WorksheetFunction.Substitute(Value, Fnd, Rplc) 

       If Err <> 0 Then 
        MsgBox "Error" 
        Exit Sub 
       End If 

       On Error GoTo 0 

       Folders(UBound(Folders)) = Value 

       ReDim Preserve Folders(UBound(Folders) + 1) 
      Else 
       On Error Resume Next 

       Fext = Split(Value, ".")(UBound(Split(Value, "."))) 
       Fname = Left(Value, Len(Value) - Len(Split(Value, ".")(UBound(Split(Value, ".")))) - 1) 
       Fname = WorksheetFunction.Substitute(Fname, Fnd, Rplc) 

       If Value <> (Fname & "." & Fext) Then 
        Mtxt = "Rename file " & Value & " to " & Fname & "." & Fext & "?" 
        x = MsgBox(Mtxt, vbYesNoCancel) 

        If x = vbCancel Then Exit Sub 
        If x = vbYes Then 
         Name FolderPath & Value As FolderPath & Fname & "."& Fext 
        End If 
       End If 

       If Err <> 0 Then 
        MsgBox "Error" 
        Exit Sub 
       End If 

       On Error GoTo 0 
      End If 
     End If 

     Value = Dir 

    Loop 

    For Each Folder In Folders 
     Call Recursive(FolderPath & Folder & "\", Fnd, Rplc) 
    Next 

End Sub 

Answer 1

如果完成你想要的，爲什麼不把某種形式的暫停是實現你的目標完成後循環。例如 -

... 
End If 
If MsgBox("Continue?", vbYesNo, "Confirm") = vbNo Then Exit Sub 
... 

我很難將代碼與您的問題建議聯繫起來。代碼似乎重命名文件和文件夾。你能更詳細地解釋一下你的目標嗎？