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
...

我很难将代码的作用与您的问题所暗示的内容联系起来。似乎代码重命名文件和文件夹。你能解释一下你的目标吗？

Excel VBA循环帮助需要

1 个答案: