宏遍历工作簿中的所有工作表

Question

I have a task to make the replacement of hyperlinks in 1000 files to a new server. I already have a working script for replacing hyperlinks, but it only works on the active page. Tell me how to make it go through all the pages in the book.

Sub changeLinks()

Const oldPrefix = "\\oldServer\common"
Const newPrefix = "\\NewServer\common"
Dim h As Hyperlink, oldLink As String, newLink As String

For Each h In ActiveSheet.Hyperlinks
    'this will change Address but not TextToDisplay
    oldLink = h.Address
    Debug.Print "Found link: " & oldLink
    If Left(oldLink, Len(oldPrefix)) = oldPrefix Then
            newLink = newPrefix & Right(h.Address, Len(h.Address) - Len(oldPrefix))


            h.Address = newLink
            Debug.Print "  Changed to " & h.Address
    End If
Next h

End Sub

Answer 1

Call your routine in a loop :

Sub ProcessAllSheets()
    Dim s As Worksheet
    For Each s In Sheets
        Call changeLinks(s.Name)
    Next s
End Sub

With these changes to your routine:

Sub changeLinks(s As String)

Const oldPrefix = "\\oldServer\common"
Const newPrefix = "\\NewServer\common"
Dim h As Hyperlink, oldLink As String, newLink As String

For Each h In Sheets(s).Hyperlinks
    'this will change Address but not TextToDisplay
    oldLink = h.Address
    Debug.Print "Found link: " & oldLink
    If Left(oldLink, Len(oldPrefix)) = oldPrefix Then
            newLink = newPrefix & Right(h.Address, Len(h.Address) - Len(oldPrefix))


            h.Address = newLink
            Debug.Print "  Changed to " & h.Address
    End If
Next h
End Sub

Answer 2

Throw a loop around your hyperlink loop to iterate through each sheet.

Sub changeLinks()
    Dim objSheet As Worksheet

    Const oldPrefix = "\\oldServer\common"
    Const newPrefix = "\\NewServer\common"
    Dim h As Hyperlink, oldLink As String, newLink As String

    For Each objSheet In ThisWorkbook.Sheets
        For Each h In objSheet.Hyperlinks
            'this will change Address but not TextToDisplay
            oldLink = h.Address

            Debug.Print "Found link: " & oldLink

            If Left(oldLink, Len(oldPrefix)) = oldPrefix Then
                newLink = newPrefix & Right(h.Address, Len(h.Address) - Len(oldPrefix))
                h.Address = newLink
                Debug.Print "  Changed to " & h.Address
            End If
        Next h
    Next
End Sub