Results 1 to 11 of 11
  1. #1
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Marietta, Georgia, USA
    Posts
    235
    Thanks
    4
    Thanked 2 Times in 2 Posts

    Modify hyperlinks in multiple Microsoft Word files

    I have a friend who has numerous Microsoft Word files in multiple nested folders. They are running Office 2000 under Windows XP.

    She installed a new version of MasterCook. She has hyperlinks in many documents that point to some MasterCook files, but they are somehow tied to the old version of the software. We need to modify the existing hyperlinks in those documents for the new version.

    We can manually delete the existing hyperlink and create a new one. But there are too many documents / folders to do this manually. I did a search here and found some VBA code to use as a starting point. I'm curious if anyone has a better solution.
    Last edited by rgrosz; 2013-07-27 at 20:35. Reason: They are using Office 2000 (not 2003)
    Rick Groszkiewicz
    Life is too short to drink bad wine (or bad coffee!)

  2. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,944
    Thanks
    0
    Thanked 203 Times in 184 Posts
    Hi Rick,

    Whatever approach you use, the issue is going to be one of ensuring the new paths still point to the same content. I imagine that, with the new version, the publishers have added/deleted some content. Without knowing the details, that could result in many of your updated links pointing to the wrong files. Accordingly, you may find yourself having to edit each & every link individually, comparing the Word articles against their corresponding prospective links.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  3. #3
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Marietta, Georgia, USA
    Posts
    235
    Thanks
    4
    Thanked 2 Times in 2 Posts
    These linked data files are not part of the MasterCook program - they were created by my friend. The new version of this program requires the data files to be located under C:/Documents and Settings/All Users/Documents/MasterCook.

    In prior years, the default location for the files was in a sub-folder underneath C:\Program Files\MasterCook XX, where XX represents the program version number <shudder>. Many of her Word documents' hyperlinks point to different locations, depending on the last time they were updated. I'll modify the macro code to look at the file location, and make sure this points to the correct location. We plan to put her MasterCook data files in a fixed location that does not change with future versions of the program.
    Last edited by rgrosz; 2013-07-27 at 20:38. Reason: Wrong location for data files
    Rick Groszkiewicz
    Life is too short to drink bad wine (or bad coffee!)

  4. #4
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,944
    Thanks
    0
    Thanked 203 Times in 184 Posts
    Hi Rick,

    With hyperlinks, there are three aspects to updating them that need to be considered, the hyperlink:
    1. path
    2. display text
    3. hover text
    The code in the link only addresses (1), so more work would need to be done if your hyperlinks display the current paths for either the display text or the hover text. Conversely, if only part of the path has changed, then only that part of the path needs editing, rather than supplying an entire new path. That has advantages if the path for different hyperlinks branch above a certain point that doesn't need to be changed.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  5. #5
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Marietta, Georgia, USA
    Posts
    235
    Thanks
    4
    Thanked 2 Times in 2 Posts
    I have the code working to locate and change hyperlinks within the current Word document. The next step is to move this into a separate VBA form, and modify the code to traverse multiple folders, and open and modify multiple Word documents.

    Code:
    Sub FindReplaceHyperlinks()
    'Modified code by Gary Frieder  February 2001
    'http://windowssecrets.com/forums/showthread.php/2958-Find-and-Replace-Hyperlinks-in-Word-2K
    
    Dim objDocHLinks As Hyperlinks
    Dim lngHypCt As Long
    Dim n As Long
    Dim strHLOrigText As String
    Dim strHLScreenTip As String
    Dim strHLOrigTextToDisplay As String
    Dim strHLOrigAddress As String
    Dim strHLNewText As String
    Dim strHLNewAddress As String
    Dim liNdex As Integer
    
    Set objDocHLinks = ActiveDocument.Hyperlinks
    lngHypCt = objDocHLinks.Count
    For n = lngHypCt To 1 Step -1
    
        strHLOrigText = objDocHLinks(n).Range.Text
        strHLScreenTip = objDocHLinks(n).Target
        strHLOrigTextToDisplay = objDocHLinks(n).TextToDisplay
        
        strHLOrigAddress = objDocHLinks(n).Address
    '    Debug.Print n, "strHLOrigText: "; strHLOrigText, "strHLScreenTip: "; strHLScreenTip
    '    Debug.Print n, "strHLOrigTextToDisplay: "; strHLOrigTextToDisplay, vbCrLf; "strHLOrigAddress: "; strHLOrigAddress
    
        strHLNewText = strHLOrigText
    
        strHLOrigAddress = objDocHLinks(n).Address
        'call function to get replacement address
        strHLNewAddress = GetNewHLAddress(strHLOrigAddress)
    
        liNdex = InStr(strHLNewAddress, "MasterCook ")
        'Don't change any other hyperlinks
        If liNdex > 0 Then
            With objDocHLinks(n).Range
                .Fields(1).Result.Select
                .Delete
            End With
            Selection.Text = strHLNewText
            objDocHLinks.Add Anchor:=Selection.Range, Address:=strHLNewAddress
            Selection.Collapse Direction:=wdCollapseEnd
        End If
    Next n
    End Sub
    
    Public Function GetNewHLAddress(strOrigAddress As String) As String
    Dim strNewAddress As String
    Dim liNdex As Integer
    
    strNewAddress = strOrigAddress
    liNdex = InStr(strOrigAddress, "MasterCook ")
    If liNdex > 0 Then
        strNewAddress = Left$(strOrigAddress, liNdex - 1) & "MasterCook 11" _
            & Mid$(strOrigAddress, liNdex + Len("MasterCook 1"))
    End If
    
    GetNewHLAddress = strNewAddress
    End Function
    Rick Groszkiewicz
    Life is too short to drink bad wine (or bad coffee!)

  6. #6
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,944
    Thanks
    0
    Thanked 203 Times in 184 Posts
    Hi Rick,

    If I understand the code you posted correctly, what you're aiming to do is to replace all instances of "MasterCook 11" in the hypelinks with "MasterCook". That being the case, try the following:
    Code:
    Option Explicit
    Public FSO As Object 'a FileSystemObject
    Public oFolder As Object 'the folder object
    Public oSubFolder As Object 'the subfolders collection
    Public oFiles As Object 'the files object
    Public i As Long, j As Long
    
    Sub Main()
    ' Minimise screen flickering
    Application.ScreenUpdating = False
    Dim StrFolder As String
    ' Browse for the starting folder
    StrFolder = GetTopFolder
    If StrFolder = "" Then Exit Sub
    ' Search the top-level folder
    Call GetFolder(StrFolder & "\")
    ' Search the subfolders for more files
    Call SearchSubFolders(StrFolder)
    ' Return control of status bar to Word
    Application.StatusBar = ""
    ' Restore screen updating
    Application.ScreenUpdating = True
    MsgBox i & " of " & j & " files updated.", vbOKOnly
    End Sub
    
    Function GetTopFolder() As String
    GetTopFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetTopFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
    End Function
    
    Sub SearchSubFolders(strStartPath As String)
    If FSO Is Nothing Then
      Set FSO = CreateObject("scripting.filesystemobject")
    End If
    Set oFolder = FSO.GetFolder(strStartPath)
    Set oSubFolder = oFolder.subfolders
    For Each oFolder In oSubFolder
      Set oFiles = oFolder.Files
      ' Search the current folder
      Call GetFolder(oFolder.Path & "\")
      ' Call ourself to see if there are subfolders below
      SearchSubFolders oFolder.Path
    Next
    End Sub
    
    Sub GetFolder(StrFolder As String)
    Dim strFile As String
    strFile = Dir(StrFolder & "*.doc")
    ' Process the files in the folder
    While strFile <> ""
      ' Update the status bar is just to let us know where we are
      Application.StatusBar = StrFolder & strFile
      Call UpdateFiles(StrFolder & strFile)
      strFile = Dir()
    Wend
    End Sub
    
    Sub UpdateFiles(strDoc As String)
    Dim Doc As Document, HLnk As Hyperlink
    ' Open the document
    Set Doc = Documents.Open(strDoc, AddToRecentFiles:=False, ReadOnly:=False, Format:=wdOpenFormatAuto, Visible:=False)
    With Doc
      If .ProtectionType = wdNoProtection Then
        ' Update the document
        For Each HLnk In .Hyperlinks
          With HLnk
            .Address = Replace(.Address, "MasterCook 11", "MasterCook")
            .TextToDisplay = Replace(.TextToDisplay, "MasterCook 11", "MasterCook")
            .ScreenTip = Replace(.ScreenTip, "MasterCook 11", "MasterCook")
          End With
        Next
        ' Update the file counter for changed files
        i = i + 1
      End If
      ' Update the main file counter
      j = j + 1
      .Close SaveChanges:=True
    End With
    ' Let Word do its housekeeping
    DoEvents
    Set Doc = Nothing
    End Sub
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  7. The Following User Says Thank You to macropod For This Useful Post:

    rgrosz (2012-12-13)

  8. #7
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Marietta, Georgia, USA
    Posts
    235
    Thanks
    4
    Thanked 2 Times in 2 Posts

    Smile

    Quote Originally Posted by macropod View Post
    Hi Rick,

    If I understand the code you posted correctly, what you're aiming to do is to replace all instances of "MasterCook 11" in the hypelinks with "MasterCook". That being the case, try the following:
    Code:
    Option Explicit
    Public FSO As Object 'a FileSystemObject
    ...
    Set Doc = Nothing
    End Sub
    WOW - I did not expect someone to write the code for me!

    I will test this code over the weekend. When everything is done, I will post back the final version.

    The code I wrote was designed to make a minor change in the location of the files beneath C:\Program Files. We discovered that MasterCook actually saves its cookbooks underneath C:\Documents and Settings. So the final version will be a bit different.
    Rick Groszkiewicz
    Life is too short to drink bad wine (or bad coffee!)

  9. #8
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Marietta, Georgia, USA
    Posts
    235
    Thanks
    4
    Thanked 2 Times in 2 Posts
    I sent some code to my MasterCook friend a week ago. They have been too busy with holidays to run any of my tests.
    Rick Groszkiewicz
    Life is too short to drink bad wine (or bad coffee!)

  10. #9
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Marietta, Georgia, USA
    Posts
    235
    Thanks
    4
    Thanked 2 Times in 2 Posts
    Quote Originally Posted by rgrosz View Post
    I sent some code to my MasterCook friend a week ago. They have been too busy with holidays to run any of my tests.
    My friend decided this wasn't important enough to pursue, so this project has been set aside temporarily. In the meantime, her computer started acting up, and had to be replaced. We just finished moving all her data and programs from Windows XP on the old PC to Windows 7 on the new PC.

    Now I have embarked on another Word macro project. She has hyperlinks in many documents that point to Dymo label files. In Windows XP, these files were located in a different folder (C:\Program Files\Dymo Label) than they are under Windows 7 (D:\Data\Dymo Label). I have written the code and tested it thoroughly on my PC.

    Here is the code I am using now:
    Code:
    Option Explicit
    Public FSO As Object           'a FileSystemObject
    Public oFolder As Object       'the folder object
    Public oSubFolder As Object  'the subfolders collection
    Public oFiles As Object         'the files object
    Public lngFileCount As Long
    Public lngFilesChg As Long
    Public strMode As String
    
    
    Sub Main()
    Dim StrFolder As String, liResponse As Integer
    
    ' Minimise screen flickering
    Application.ScreenUpdating = False
    lngFileCount = 0
    lngFilesChg = 0
    
    ' Browse for the starting folder
    StrFolder = GetTopFolder
    If StrFolder = "" Then Exit Sub
    
    ' Start off with just the file count
    strMode = "count"
    ' Search the top-level folder
    Call GetFolder(StrFolder & "\")
    ' Search the subfolders for more files
    Call SearchSubFolders(StrFolder)
    
    liResponse = MsgBox(lngFileCount & " files found", vbYesNo, "Ready to Update files?")
    
    If liResponse = vbYes Then
        ' Now actually update the files
        strMode = "update"
        ' Search the top-level folder
        Call GetFolder(StrFolder & "\")
        ' Search the subfolders for more files
        Call SearchSubFolders(StrFolder)
        
        
        ' Return control of status bar to Word
        Application.StatusBar = ""
        ' Restore screen updating
        Application.ScreenUpdating = True
        
        MsgBox lngFilesChg & " of " & lngFileCount & " files updated.", vbOKOnly
    End If
    
    End Sub
    
    '****************************************************
    
    Function GetTopFolder() As String
    
    Dim lsDrive As String, liDrive_E As Integer
    
    'Add logic to run on Rick's PC - with no Drive D:
    'Rita has Office 2000 - Word version is 9
    'Rick has Office 2003 - Word version is 11
    
    lsDrive = "D:"
    If Application.Version > 10.5 Then lsDrive = "E:"
    
    GetTopFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 1, lsDrive + "\msoffice")
    If (Not oFolder Is Nothing) Then GetTopFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
    End Function
    
    '****************************************************
    
    Sub SearchSubFolders(strStartPath As String)
    
    If FSO Is Nothing Then
      Set FSO = CreateObject("scripting.filesystemobject")
    End If
    
    Debug.Print strStartPath
    
    Set oFolder = FSO.GetFolder(strStartPath)
    Set oSubFolder = oFolder.subfolders
    
    For Each oFolder In oSubFolder
      Set oFiles = oFolder.Files
      ' Search the current folder
      Call GetFolder(oFolder.Path & "\")
      ' Call ourself to see if there are subfolders below
      SearchSubFolders oFolder.Path
    Next
    
    End Sub
    
    '****************************************************
    
    Sub GetFolder(StrFolder As String)
    Dim strFile As String
    
    strFile = Dir(StrFolder & "*.doc")
    ' Process the files in the folder
    
    While strFile <> ""
    DoEvents
    
        If strMode = "update" Then
            ' Update the status bar is just to let us know where we are
            Application.StatusBar = StrFolder & strFile
            Call UpdateFiles(StrFolder & strFile)
        Else
          ' Update the main file counter
          lngFileCount = lngFileCount + 1
        End If
          
        strFile = Dir()
    Wend
    
    End Sub
    
    '****************************************************
    
    Sub UpdateFiles(strDoc As String)
    Dim doc As Document, HLnk As Hyperlink
    Dim liNdex As Integer, strOrigAddress As String, liFlag As Integer
    
    ' Open the document
    Set doc = Documents.Open(strDoc, AddToRecentFiles:=False, ReadOnly:=False, Format:=wdOpenFormatAuto, Visible:=False)
    
    With doc
      If .ProtectionType = wdNoProtection Then
        ' Update the document
        For Each HLnk In .Hyperlinks
          With HLnk
            
    '            
    ' current (bad) path when editing hyperlink manually
    ' ../../../../../Program%20Files/DYMO%20Label/FOOD%20LABELS/Asian%20Foods/Egg%20Foo%20Yung,%20Spinach.label
    '
    ' path when showing hyperlink via ALT-F9
    ' "../../../../../Program Files/DYMO Label/FOOD LABELS/Asian Foods/Egg Foo Yung, Spinach.label"
    '
    
            'Trap the javascript hyperlink error on Rita's PC
            On Error GoTo ErrorSkip
            
            strOrigAddress = .Address
            
            'Skip over hyperlinks already processed
            liNdex = InStr(LCase$(strOrigAddress), "file://d:\data\dymo label")
            If liNdex > 0 Then GoTo FixedAlready
            
            'Don't change any other hyperlinks
            liNdex = InStr(LCase$(strOrigAddress), "dymo label")
            If liNdex > 0 Then
                .Address = "D:/Data/Dymo Label" _
                    & Mid$(strOrigAddress, liNdex + Len("Dymo Label"))
                liFlag = 1
            End If
            
    ErrorSkip:
          End With
        
        Next 'HLnk
        ' Update the file counter for changed files
        If liFlag = 1 Then lngFilesChg = lngFilesChg + 1
        
      End If
    
    FixedAlready:
      ' Update the file with any changes
      If liFlag = 1 Then
        .Close SaveChanges:=True
      Else
        .Close SaveChanges:=False
      End If
      
    End With
    
    ' Let Word do its housekeeping
    DoEvents
    
    On Error GoTo 0
    Set doc = Nothing
    End Sub
    The annoying thing is that this code will fail on a few of her Word documents (she has over 15,000 documents in about 200 nested folders). When she sends me the "bad" document, this VBA code works fine on my computer - color me confused

    My first attempt to fix this was the error trapping logic that simply skips ANY errors. I thought that would solve any problems that cropped up on her computer. But the latest snafu has my code behaving in a truly bizarre manner. The "bad" document has about 800 hyperlinks, and the VBA code crashes after processing 481 of them. When it gets to the hyperlink #482, the code fails on the line that gets the hyperlink address.

    I have set breakpoints and single stepped through this code in the VBE debugger. It shows that the hyperlink object exists on one line of code, then it indicates that the hyperlink object has been deleted. And the best part is this - when I run this VBA code on that same document on my PC, it works fine.

    I'm curious if anyone has seen anything this weird before - I have no explanation how this could happen. My current plan is to get all of the 15,000 Word documents on a portable drive and process them on my PC.
    Last edited by macropod; 2013-09-25 at 05:30. Reason: Merged posts
    Rick Groszkiewicz
    Life is too short to drink bad wine (or bad coffee!)

  11. #10
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,944
    Thanks
    0
    Thanked 203 Times in 184 Posts
    Hi Rick,

    I've been OS for 3½ months, hence the delay in replying.

    It's possible there are some timing issues on your friend's system. That could be triggered by another app (eg AV software scans). Alternatively, it could be due to a fault in the Office/Word installation, change tracking (if it's 'on'), or the number of edits in the existing document slowing things down and introducing a different kind of timing issue. If it always fails at hyperlink 481/482, that's a definite possibility and the fix might be something as simple as turning off spell-checking and/or clearing the undo buffer.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  12. #11
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Marietta, Georgia, USA
    Posts
    235
    Thanks
    4
    Thanked 2 Times in 2 Posts
    I actually finished both of these projects a few weeks ago. I combined the code to handle both the Dymo hyperlinks and the Mastercook hyperlinks. The simplest solution to the weird problems I encountered was to process all 15,000 Word documents on my PC. It took 35 minutes to run, and only about 650 documents were changed.
    Rick Groszkiewicz
    Life is too short to drink bad wine (or bad coffee!)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •