View Single Post
 
Old 08-02-2023, 03:25 AM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,138
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Your sample documents have manual formatting in the form of pink shading that is at the root of the problem. I would also recommend that you put the code in an add-in template or the normal template rather than a document. The following will remove the formatting from the hyperlinks and adopt the hyperlink styles that are present in the documents.
Code:
Option Explicit

Sub UpdateDocuments3()
'Graham Mayor - https://www.gmayor.com - Last updated - 02 Aug 2023
Dim strFolder As String, strFile As String
Dim wdDoc As Document
Dim oLink As Hyperlink
    strFolder = BrowseForFolder("Select folder containing the documents to process")
    If strFolder = "" Then Exit Sub
    strFile = Dir(strFolder & "*.docx")
    While strFile <> ""
        Set wdDoc = Documents.Open(FileName:=strFolder & strFile, AddToRecentFiles:=False, Visible:=True)
        'Debug.Print strFile
        With wdDoc
            For Each oLink In .Hyperlinks
                oLink.Range.Select
                Selection.ClearFormatting
            Next oLink
            .Close SaveChanges:=True
        End With
        strFile = Dir()
    Wend
    Set wdDoc = Nothing
    MsgBox "finished.", vbOKOnly
End Sub
 
Private Function BrowseForFolder(Optional strTitle As String) As String
'Graham Mayor
'strTitle is the title of the dialog box
Dim fDialog As FileDialog
    On Error GoTo Err_Handler
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = strTitle
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then GoTo Err_Handler:
        BrowseForFolder = fDialog.SelectedItems.Item(1) & Chr(92)
    End With
lbl_Exit:
    Exit Function
Err_Handler:
    BrowseForFolder = vbNullString
    Resume lbl_Exit
End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote