Changing hyperlink addresses

[sspatriots]

The following post is cross-posted at Need help with changing hyperlink addresses

I've used similar code like what I have below with much success. However, this time the hyperlinks changed such that they have the "%20" in the address for spaces. I need to get the "%20" replaced with spaces and get the first part of that file path changed to the new string I have specified. When I run the code I get the error "Run-time error '7': Out of Memory at the line that after "Else". I have no clue what I have wrong here. Any help would be much appreciated. Thanks, SS

Sub FixPOHyperlinks()

    Dim wBook As Workbook
    Dim wSheet As Worksheet
    Dim tb As ListObject
    Dim OldStr As String, NewStr As String
    Dim hyp As Hyperlink
    Dim sOldAddress As String, sNewAddress As String

    Set wBook = ThisWorkbook
    Set wSheet = wBook.Sheets("Sheet1")
    Set tb = wSheet.ListObjects("Table1")

    Worksheets("Sheet1").Activate

    OldStr = "https://companyname-my.sharepoint.com/personal/mescobal_companyname_com/Documents/H%20drive"
    NewStr = "\\abc.local\DEM"
    
    For Each wSheet In Worksheets
       
        For Each hyp In tb.ListColumns("Machine PO").DataBodyRange.Hyperlinks
    
            If InStr(1, hyp.Address, "\") > 0 Then
                hyp.Address = Replace(hyp.Address, OldStr, NewStr)
                hyp.Address = Replace(hyp.Address, "%20", Chr(32))
            Else
                hyp.Address = NewStr & "\" & hyp.Address
            End If
    
            'hyp.TextToDisplay = Replace(hyp.Address, OldStr, NewStr)

        Next hyp

    Next

End Sub

 

[Micron]

You could hit the line after Else in the first pass, or that could be happening in the 5000th pass. Put a break point at Else line, trigger the code and step through (F8). If after several loops there's no error, then perhaps insert a counter in the inner loop and increment the counter by one on each pass. Move the break point to Next line and just run it. If it errors, you should be prompted to debug or not. Choose debug and your procedure should open up halted & there you can check the value of the counter by mousing over the counter variable. You could also check which sheet it's on by typing ?wSheet.Name in the immediate window and hit enter. Point is to play with execution in stages; i.e. putting a break point on outer For or Next would allow the inner loop to process completely, in which case you can click run button in toolbar to run until it hits the break point again, thus from one sheet to another instead of stepping through each sheet row.

It may be a memory issue, in which case you might have to go so far then save the workbook (it may be that there's not enough buffer space for the unsaved data). Knowing how far you got in the process might provide a clue about that. It could also be an issue with data, which doesn't always raise the most enlightening of error messages.

 

[sspatriots]

Ended up changing the OldStr and NewStr to what is below as well as changing the backslash in the If statement to a forwardslash and it seemed to do the job. Also removed the "For Each wSheet In Worksheets" bit since I was only dealing with the one worksheet. Thank you

Sub FixPOHyperlinks()

    Dim wBook As Workbook
    Dim wSheet As Worksheet
    Dim tb As ListObject
    Dim OldStr As String, NewStr As String
    Dim hyp As Hyperlink
    Dim sOldAddress As String, sNewAddress As String

    Set wBook = ThisWorkbook
    Set wSheet = wBook.Sheets("Sheet1")
    Set tb = wSheet.ListObjects("Table1")

    Worksheets("Sheet1").Activate

    OldStr = "https://companyname-my.sharepoint.com/personal/mescobal_companyname_com/Documents/H drive"
    NewStr = ""
    
        For Each hyp In tb.ListColumns("Machine PO").DataBodyRange.Hyperlinks
    
            If InStr(1, hyp.Address, "/") > 0 Then
                hyp.Address = Replace(hyp.Address, OldStr, NewStr)
            
            Else
                hyp.Address = NewStr & "/" & hyp.Address
            End If
    
            'hyp.TextToDisplay = Replace(hyp.Address, OldStr, NewStr)

        Next hyp
        

End Sub