Results 1 to 2 of 2
  1. #1
    New Lounger
    Join Date
    Feb 2016
    Posts
    1
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Using a macro to relink Excel files

    I am having trouble getting this macro to work. I am working on a Windows 10 computer with Office 2013. The code was not written by me and I have limited knowledge in VB. The marco is supposed to update a a word document's links by mirroring how the the previous word document was linked. Below is the code, if anyone could help that would be great.
    Code:
    Sub relinking()
    
    Dim oriacro As String
    Dim taracro As String
    Dim path As String
    
    oriacro = InputBox(Prompt:="please enter the original agency acronym.", Title:="ENTER THE ORIGINAL AGENCY ACRONYM")
    taracro = InputBox(Prompt:="please enter the target agency acronym.", Title:="ENTER THE TARGET AGENCY ACRONYM")
    path = InputBox(Prompt:="please enter the target path.", Title:="ENTER THE TARGET PATH")
    
    Excel.Application.Quit
    'close all the excel files.(excel reference has to be activated in tool->reference'
    
    For x = 1 To ActiveDocument.Fields.Count
    'the program runs over all the linked fields'
    
    If Left(ActiveDocument.Fields(x).LinkFormat.SourceNam  e, Len(oriacro)) = oriacro Then
    'read all the fields that has "original agency acronym" in the beginning of its linked excel files.'
    ActiveDocument.Fields(x).LinkFormat.SourceFullName = path & "\"  & taracro & "_" &  Right(ActiveDocument.Fields(x).LinkFormat.SourceNa  me,  Len(ActiveDocument.Fields(x).LinkFormat.SourceName  ) -  InStr(ActiveDocument.Fields(x).LinkFormat.SourceNa  me, "_"))
    'Assign the fields with new links that are created from combining the  "target path" ,"target agency acronym", and the parts of the names right  after the original acronyms of the original linked file names.'
    Else
    'Leave other linked fields as they are.'
    End If
    Next x
    
    MsgBox ("All Fields have been relinked!")
    End Sub
    Last edited by gmason2; 2016-02-09 at 17:44. Reason: Added Code Tags

  2. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    The code looks OK, and there's no particular reason it shouldn't work. That said, the code could be made more efficient and robust:
    Code:
    Sub Relinking()
    Application.ScreenUpdating = False
    Dim oriacro As String, taracro As String, path As String, strNm As String
    oriacro = InputBox(Prompt:="please enter the original agency acronym.", Title:="ENTER THE ORIGINAL AGENCY ACRONYM")
    If Trim(oriacro) = "" Then
      MsgBox "No original agency acronym supplied. Exiting", vbCritical
      Exit Sub
    End If
    taracro = InputBox(Prompt:="please enter the target agency acronym.", Title:="ENTER THE TARGET AGENCY ACRONYM")
    If Trim(taracro) = "" Then
      MsgBox "No target agency acronym supplied. Exiting", vbCritical
      Exit Sub
    End If
    path = InputBox(Prompt:="please enter the target path.", Title:="ENTER THE TARGET PATH")
    With ActiveDocument
      For x = 1 To .Fields.Count
        With .Fields(x)
          If Not .LinkFormat Is Nothing Then
            With .LinkFormat
              strNm = .SourceName
              If Left(strNm, Len(oriacro)) = oriacro Then .SourceName = taracro & "_" & Left(strNm, Len(strNm) - InStr(strNm, "_"))
              If Trim(path) <> "" Then .SourcePath = path
            End With
            .Update
          End If
        End With
      Next
    End With
    Application.ScreenUpdating = True
    MsgBox ("All Fields have been relinked!")
    End Sub
    With the above modifications, the code will exit if either the original or target agency acronym is not supplied and will retain the existing path if no path is supplied.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

Posting Permissions

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