Как мне легко изменить жестко запрограммированные ссылки на файл в Excel?

Question

У меня есть проект, в котором я веду список всех моих учеников и их информацию в файле Excel с пометкой «BigList.xlsx». Затем у меня есть около 40-50 других отдельных вспомогательных файлов Excel, которые ссылаются на BigList с помощью VLOOKUP.

Например, в ячейке 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 файлов для обновления их ссылок.

Answer 1

Это должно делать то, что вам нужно - может быть, не очень быстро, но если вам нужно сделать это только один раз на 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

Answer 2

Вы можете сделать это в Excel 2010 без использования кода. (Если память служит, она также будет работать в более ранних версиях Excel.)

1. Одновременно открыть все 50 вспомогательных файлов Excel в Excel.
2. Откройте BigList.xlsx. (Теперь у вас есть 51 файл, открытый в Excel.)
3. Нажмите File - Save As и сохраните BigList как MasterDatabase.xlsm
4. Закройте новый файл MasterDatabase.xlsm.
5. Посмотрите на один из вспомогательных файлов и убедитесь, что в Excel он указывает на новый файл.
6. Закройте и сохраните все файлы.

Answer 3

Этот код автоматизирует изменение ссылки напрямую

1. Обновите ваши пути до BigList.xlsx и MasterDatabase.xlsm в коде
2. Обновите ваш путь до 40-50 файлов (Я использовал c: \ temp \ ")
3. Затем код откроет оба этих файла (для более быстрой перекомпоновки), затем откроет файлы в strFilePath, изменит ссылку с WB1 (strOldMasterFile) наWb2 (strOldMasterFile), затем закройте сохраненный файл

Обратите внимание, что предполагается, что все эти файлы закрываются при запуске кода, так как код откроет эти файлы

    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