如何轻松地将硬编码链接更改为Excel中的文件?

时间:2012-03-19 17:21:30

标签: excel excel-vba hyperlink excel-formula vlookup vba

我有一个项目,我在一个标有“BigList.xlsx”的Excel文件中维护所有学生及其信息的列表。然后,我有大约40-50个其他单独的辅助excel文件,使用VLOOKUP链接到BigList。

例如,在辅助文件的单元格A1中,您可能会看到如下所示的公式:

=Vlookup(B3, 
    'c:\documents and settings\user\desktop\[BigList.xlsx]Sheet1'!$a$1:$b$10000,
    2,false).

上面的vlookup链接引用了BigList.xlsx。但是,我才意识到我需要将该文件名更改为其他内容,例如MasterDatabase.xlsm(注意不同的扩展名)。有没有一个简单的方法来做到这一点,而无需手动浏览所有40-50个文件并进行查找&取代

我认为基本的想法是将硬编码链接更改为动态链接,我可以随时更改BigList.xlsx的文件名,而不必返回所有40-50个文件来更新其链接。

3 个答案:

答案 0 :(得分:4)

这应该做你需要的 - 也许不是超级快,但如果你只需要在50个工作簿上做一次它应该足够好。请注意,替换行应在工作簿的所有工作表中进行替换。

Option Explicit

Public Sub replaceLinks()

    Dim path As String
    Dim file As String
    Dim w As Workbook
    Dim s As Worksheet

    On Error GoTo error_handler

    path = "C:\Users\xxxxxx\Documents\Test\"
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    file = Dir$(path & "*.xlsx", vbNormal)
    Do Until LenB(file) = 0
        Set w = Workbooks.Open(path & file)
        ActiveSheet.Cells.Replace What:="'THE_LINK_YOU_WANT_TO_CHANGE'!", _
                Replacement:="'THE_NEW_LINK'!", LookAt:=xlPart
        w.Save
        w.Close
        file = Dir$
    Loop

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    Exit Sub

error_handler:
    MsgBox Err.Description
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

答案 1 :(得分:3)

您可以在Excel 2010中执行此操作,而无需使用任何代码。 (如果内存服务,它也可以在早期版本的Excel中使用。)

  1. 同时在Excel中打开所有50个辅助Excel文件。
  2. 打开BigList.xlsx。 (您现在在Excel中打开了51个文件。)
  3. 点击File - Save As并将BigList保存为MasterDatabase.xlsm
  4. 关闭新的MasterDatabase.xlsm文件。
  5. 查看其中一个辅助文件,并验证Excel是否指向新文件。
  6. 关闭并保存所有文件。

答案 2 :(得分:2)

此代码将直接自动更改链接

  1. 在代码
  2. 中更新BigList.xlsxMasterDatabase.xlsm的路径
  3. 更新40-50个文件的路径(我使用过c:\ temp \“)
  4. 然后代码将打开这两个文件(以便更快地重新链接),然后通过打开strFilePath中的文件,将WB1(strOldMasterFile)中的链接更改为Wb2(strOldMasterFile),然后关闭保存的文件< / LI>

    请注意,假设代码启动时所有这些文件都已关闭,因为代码将打开这些文件

        Sub ChangeLinks()
            Dim strFilePath As String
            Dim strFileName As String
            Dim strOldMasterFile As String
            Dim strNewMasterFile As String
    
            Dim WB1 As Workbook
            Dim WB2 As Workbook
            Dim WB3 As Workbook
    
            Dim lngCalc As Long    
    
            strOldMasterFile = "c:\testFolder\bigList.xlsx"
            strNewMasterFile = "c:\testFolder\newFile.xlsm"
    
            On Error Resume Next
            Set WB1 = Workbooks.Open(strOldMasterFile)
            Set WB2 = Workbooks.Open(strNewMasterFile)
            If WB1 Is Nothing Or WB2 Is Nothing Then
                MsgBox "One (or both) of " & vbnerwline & strOldMasterFile & vbNewLine & strNewMasterFile & vbNewLine & "cannot be found"
                WB1.Close False
                WB2.Close False
                Exit Sub
            End If
            On Error GoTo 0
    
            With Application
                .DisplayAlerts = False
                .ScreenUpdating = False
                .EnableEvents = False
                lngCalc = .Calculation
                .Calculation = xlCalculationManual 
            End With
    
            strFilePath = "c:\temp\"
            strFileName = Dir(strFilePath & "*.xls*")
    
            'Error handling as link may not exist in all files
            On Error Resume Next
            Do While Len(strFileName) > 0
                Set WB2 = Workbooks.Open(strFilePath & strFileName, False)
                WB2.ChangeLink strOldMasterFile, strNewMasterFile, xlExcelLinks
                WB2.Save
                WB2.Close False
                strFileName = Dir
            Loop
            On Error GoTo 0
    
            WB1.Close False
            WB2.Close False
    
            With Application
                .DisplayAlerts = True
                .ScreenUpdating = True
                .EnableEvents = True
                .Calculation = lngCalc
            End With
    
            End Sub