Excel VBA更新链接

Question

I am trying to set up a VBA macro to update link paths in excel. I looked up some code online and tried to put it together, and am getting errors. I am wondering if i could get some direction here. Please note that i am not a programmer by profession, just trying to reduce some manual updating work.

Cheers!

Private Sub CommandButton1_Click()

Dim FolderPath As String
Dim FSO As Object
Dim bookname As String
Dim wbook As Workbook
Dim oldname As String
Dim newname As String

oldname = "C:\Users\XX\Documents\[Broadstreet.xlsx]"

newname = "C:\Users\XX\Documents\[Broadstreet2.xlsx]"

FolderPath = "C:\Users\XX\Documents1"


With Application
    .ScreenUpdating = False
    .AskToUpdateLinks = False
End With


For Each Workbook In FSO.GetFolder(FolderPath).Files
    bookname = Workbook.Name

    MsgBox (bookname)

    Set wb = Workbooks.Open(FolderPath & "\" & bookname)

   ActiveWorkbook.ChangeLink oldname1, newname1, xlLinkTypeExcelLinks


   wb.Close SaveChanges:=True

Next

Application.ScreenUpdating = True

End Sub

Answer 1

Workbooks in Folder Treatment

• Loops through all Excel files (workbooks) in a folder, opens each one, changes a link from one document to another, saves the changes and closes the workbook.

• xlLinkTypeExcelLinks is the default parameter of the Type argument of the ChangeLink method and can therefore be omitted.
• .Close True can be used in this way because SaveChanges is the first argument of the Close method.

The Code

Private Sub CommandButton1_Click()

  Const strOld As String = "C:\Users\XX\Documents\[Broadstreet.xlsx]"
  Const strNew As String = "C:\Users\XX\Documents\[Broadstreet2.xlsx]"
  Const strPath As String = "C:\Users\XX\Documents1"
  Const strExt As String = "*.xls*"

  Dim strName As String

  With Application
    .ScreenUpdating = False
    .AskToUpdateLinks = False
  End With

  On Error GoTo ProcedureExit

  strName = Dir(strPath & "\" & strExt)

  Do While strName <> ""
    With Workbooks.Open(strPath & "\" & strName)
      .ChangeLink strOld, strNew
      .Close True
    End With
    strName = Dir
  Loop

ProcedureExit:
  With Application
    .AskToUpdateLinks = True
    .ScreenUpdating = True
  End With

End Sub