0

All right, this is my second attempt at a code, and the second VBA macro project I've been assigned to work on. I've been working to learn VBA as my first coding language for the last week and a half, so I apologize for silly mistakes. That said, straight to business. Here's what I put together for a word document macro:

Sub MacroToUpdateWordDocs()
    'the following code gets and sets a open file command bar for word documents
    Dim Filter, Caption, SelectedFile As String
    Dim Finalrow As String
    Dim FinalrowName As String
    Filter = "xlsx Files (*.xlsx),*.xlsx"
    Caption = "Please Select A .xlsx File, " & TheUser
    SelectedFile = Application.GetOpenFilename(Filter, , Caption)
    'check if value is blank if it is exit
    Finalrow = Cells(Rows.Count, 1).End(xlUp).Row
    FinalrowName = Finalrow + 1
    If (Trim(SelectedFile) = "") Then
        Exit Sub
    Else
        'setting up the inital word application object
        Set auditmaster = CreateObject("excel.sheet")
        'opening the document that is defined in the open file dialog
        auditmaster.Application.Workbooks.Open (SelectedFile)
        'ability to change wether it needs to burn cycles updating the UI
        auditmaster.Visible = False
        'declare excel sheet
        Dim wdoc As Document
        'set active sheet
        Set wdoc = Application.ActiveDocument
        Dim i As Integer
        Dim u As Integer
        Dim ColumnAOldAddy As String
        Dim ColumnCNewAddy As String
        u = 1
        i = 1
        'MsgBox (wordapp.ActiveDocument.Hyperlinks.Count)
        'Sets up a loop to go through the Excel Audit file rows.
        For i = 1 To auditmaster.ActiveSheet.Rows.Count
            'Identifies ColumnAOldAddy and ColumnCNewAddy as columns A and C for each row i.  Column A is the current hyperlink.address, C is the updated one.
            ColumnAOldAddy = auditmaster.Cells(i, 1)
            ColumnCNewAddy = auditmaster.Cells(i, 3)
            'If C has a new hyperlink in it, then scan the hyperlinks in wdoc for a match to A, and replace it with C
            If ColumnCNewAddy = Not Nothing Then
                For u = 1 To doc.Hyperlinks.Count
                    'If the hyperlink matches.
                    If doc.Hyperlinks(u).Address = ColumnAOldAddy Then
                        'Change the links address.
                        doc.Hyperlinks(u).Address = ColumnCNewAddy
                    End If
                'check the next hyperlink in wdoc
                Next
            End If
            'makes sure the macro doesn't run on into infinity.
            If i = Finalrow + 1 Then GoTo Donenow
        'Cycles to the next row in the auditmaster workbook.
        Next
Donenow:
        'Now that we've gone through the auditmaster file, we close it.
        auditmaster.ActiveSheet.Close SaveChanges:=wdDoNotSaveChanges
        auditmaster.Quit SaveChanges:=wdDoNotSaveChanges
        Set auditmaster = Nothing
    End If
End Sub

So, this code is suppose to take a hyperlink audit file created by my first macro (The last bugs fixed and functioning wonderfully thanks to the Stack Overflow community!). The audit file has 3 columns and a row for each hyperlink it found in the target .docx: A = hyperlink address, B = Hyperlink displaytext, and C = the new Hyperlink address

When the code runs from the .docx file to be updated, it allows the user to choose the audit file. From there, it goes row by row to check if an updated hyperlink address has been written into the C column by the older audited address/display name, then searches the .docx file for the old hyperlink address and replaces it with the new hyperlink address. At that point, it finishes searching the document then moves on to the next row in the audit excel file.

My problem is that much of this code is copy/pasted out of code from an excel macro. I have been having a hell of a time figuring out how translate that code into something that identifies/references the word/excel documents appropriately. I'm hoping someone with more experience can take a peek at this macro and let me know where I've completely buggered up. It keeps giving me "Method or data member not found" errors all over the place currently, primarily concerning where I attempt to reference the audit excel file. I'm pretty sure that this is a relatively easy fix, but I don't have the vocabulary to figure out how to Google the answer!

Community
  • 1
  • 1
  • This `Dim Filter, Caption, SelectedFile As String` doesn't do what you think it does. See explanation in [this previous answer](http://stackoverflow.com/a/11089684/119775) of mine. I don't think this issue is causing problems in this specific case, but it certainly can, so it's a bad habit to get rid of. – Jean-François Corbett Aug 29 '12 at 06:49
  • Ahh, thank you Jean-François. That is certainly a mistake I've been guilty of on more than this occation. – user1625335 Aug 29 '12 at 14:00

1 Answers1

1

Compiled OK, but not tested:

Sub MacroToUpdateWordDocs()

    Dim Filter, Caption, SelectedFile As String
    Dim Finalrow As String
    Dim appXL As Object
    Dim oWB As Object
    Dim oSht As Object
    Dim wdoc As Document
    Dim ColumnAOldAddy As String
    Dim ColumnCNewAddy As String
    Dim i As Long
    Dim h As Word.Hyperlink
    Dim TheUser As String

    Filter = "xlsx Files (*.xlsx),*.xlsx"
    Caption = "Please Select A .xlsx File, " & TheUser

    Set appXL = CreateObject("excel.application")
    appXL.Visible = True
    SelectedFile = appXL.GetOpenFilename(Filter, , Caption)
    appXL.Visible = False

    If Trim(SelectedFile) = "" Then
        appXL.Quit
        Exit Sub
    Else
        Set oWB = appXL.Workbooks.Open(SelectedFile)
        Set oSht = oWB.worksheets(1)
        Finalrow = oSht.Cells(oSht.Rows.Count, 1).End(-4162).Row '-4162=xlUp
    End If

    Set wdoc = Application.ActiveDocument

    For i = 1 To Finalrow

        ColumnAOldAddy = oSht.Cells(i, 1).Value
        ColumnCNewAddy = oSht.Cells(i, 3).Value

        If ColumnCNewAddy <> ColumnAOldAddy Then
            For Each h In wdoc.Hyperlinks
                If h.Address = ColumnAOldAddy Then
                    h.Address = ColumnCNewAddy
                End If
            Next h
        End If

    Next i

    oWB.Close False
    appXL.Quit

End Sub
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • That worked magnificantly. And I've now learned how to properly reference excel using the file selection application (not to mention a couple ways to clean up my own code). Thank you thrice over! – user1625335 Aug 29 '12 at 16:11
  • Just a quick question, though. What does this line do? If ColumnCNewAddy <> ColumnAOldAddy Then – user1625335 Aug 29 '12 at 16:47
  • You only need to update the hyperlink if the "new" address is different from the "old" address. `<>` means "is not equal to" – Tim Williams Aug 29 '12 at 18:11