Как ссылаться на ссылку Excel, используя уникальный идентификатор в VBA

Как обратиться к внешним рабочим книгам в VBA, используя уникальный идентификатор, который не изменяется при открытии файла? Он прекрасно работает, когда включен полный путь к файлу и файл с таким именем не открыт. Однако, когда файл открыт, полная форма с путем к файлу не работает, и само имя файла не работает.

Я хотел создать обновление Sub, чтобы обновить все ссылки, и это портит само себя, если электронная таблица открыта (см. Пункт 2 ниже).

Вот несколько причин, почему я считаю, что это возможно:

  1. Похоже, что в меню обновления ссылки вручную есть только имя файла, к которому можно обратиться;
  2. Также нельзя открыть две книги с одним и тем же именем, и, таким образом, если вы откроете ссылку на источник, ссылки на ячейки изменятся с пути к файлу на имя файла (и именно это вызывает проблему.

Это код, который у меня есть updCellRef ссылка на ячейку для пути к файлу (где я просто хочу использовать имя файла):

    Sub updateValues(updCellRef)
        updFilePath = ActiveWorkbook.Sheets("INPUTS").Range(updCellRef).Value
        ActiveWorkbook.updateLink Name:=updFilePath, Type:=xlExcelLinks
    End Sub

Чтобы прояснить эту проблему, возникла проблема, когда я использовал вышеуказанную функцию для обновления значений, однако, когда исходная электронная таблица была открыта, на нее ссылается только имя файла. Когда он закрыт, на него ссылается полный путь к файлу.

Я использую Excel Professional 2010 v14 с VBA v7.0

Примечание. Я не хочу использовать любое другое программное обеспечение, включая Power Query, поскольку его нельзя установить без прав администратора.

5 ответов

Решение

Есть два способа добавить информацию к имени файла, чтобы сделать его уникальным: открыть файл в Excel, где видно, что открытые файлы не имеют одинаковые имена, или включить полный путь. Таким образом, вы не можете "ссылаться на внешние книги в VBA, используя только имя файла", если они не открыты, так как тогда будет неопределенность, к какому из всех файлов с одинаковыми именами вы обращаетесь.

Вот источник в MS Office Support, который говорит, что "Когда источник не открыт, внешняя ссылка включает весь путь"

Обновление: учитывая комментарии к исходному вопросу, я думаю, что мы здесь:

  1. Мы довольны открытыми файлами и любыми ссылками на них, которые должны быть уже обновлены, так как они открыты
  2. У нас есть список файлов, которые мы хотели бы принудительно обновить, если мы можем найти их по заданным путям и если нет другого файла с таким же именем файла открытым

Теперь попробуйте это:

 Sub updateValues(updFilepath As String)
    If Not FileInUse(updFilepath) Then
        ActiveWorkbook.UpdateLink Name:=updFilepath, Type:=xlExcelLinks
    'else workbook is open and Excel have automatically updated linke
    End If
End Sub

Public Function FileInUse(sFileName As String) As Boolean
On Error Resume Next
Open sFileName For Binary Access Read Lock Read As #1
Close #1
FileInUse = IIf(Err.Number > 0, True, False)
On Error GoTo 0 
End Function

Функция проверки файла предоставлена ​​пользователем 2267971 и ответила на этот вопрос также о том, как проверить, открыт ли файл

Это альтернативный способ ссылки на ссылки.

Dim linkName As String, fileName As String, i As Integer

For Each link In ActiveWorkbook.LinkSources
    On Error GoTo tryName
    ActiveWorkbook.UpdateLink linkName

    If False Then
  tryName:
        i = InStrRev(linkName, "\") ' 0 if no "\" found
        If i > 0 Then
            On Error Resume Next ' to ignore error if fileName does not work too
            fileName = Mid(linkName, i + 1)
            ActiveWorkbook.UpdateLink fileName 
        End If
    End If
    On Error GoTo 0 ' reset the error handling        
Next

тем не мение link как и прежде, это строка пути к файлу

Обновить

Можете ли вы опубликовать скриншот Data > Edit Links, чтобы сделать его немного более понятным?

В моих тестах первые 3 ссылки были в порядке, но у последней были проблемы.

Я могу подумать о 2 сценариях, которые вы можете иметь здесь:


1. По названию я могу предположить, что проблема заключается в том, что рабочие книги, на которые вы пытаетесь ссылаться, находятся в подпапке родительской рабочей книги; если это так, я заметил, что даже когда вы указываете полный путь, он работает какое-то время, а затем пропускает путь к нему - кажется, это ошибка (хотя я не знаю, что ее вызывает)-. Ссылки работают только в интерфейсе Excel, но, когда вы пытаетесь играть с гиперссылкой в ​​vba, это дает ошибку, потому что полный путь обрезан, и это приводит к неполному пути - то есть, чтобы проверить его, он говорит, что больше не действителен -, У меня нет другого решения, которое, когда это произойдет, снова попросит пользователя указать путь (используйте основную ячейку для всех процессов, которые полагаются на это, чтобы упростить исправление / обход). Это может решить это для того, чтобы получить его по VBA. Просто убедитесь, что значение ячейки имеет полное имя для рабочей книги при запросе его-

    Sub Test()
    Dim HLToTest As String
        HLToTest = RetriveWBLink(Range("B2").Value)
    End Sub
    Function RetriveWBLink(WBName As String) As String
    Dim FileSystemLibrary As Object: Set FileSystemLibrary = CreateObject("Scripting.FileSystemObject")
        On Error GoTo Err01RetriveWBLink
        RetriveWBLink = FileSystemLibrary.GetFile(ThisWorkbook.Path & "\" & WBName)
        If 1 = 2 Then '99. If error
Err01RetriveWBLink:
        'this may happen for new workbooks that aren't saved yet
        RetriveWBLink = "False"
        End If '99. If error
        On Error GoTo -1
        Set FileSystemLibrary = Nothing
    End Function


2. Если (1) не так, это должно решить эту проблему путем получения полного пути к указанному WB (это просто обновление ссылки, не важно, открыта она или нет)

Sub Test()
Dim HLToTest As String
    HLToTest = RetriveWBLink(ThisWorkbook)
End Sub
Function RetriveWBLink(WBName As Workbook) As String
Dim FileSystemLibrary As New Scripting.FileSystemObject
    On Error GoTo Err01RetriveWBLink
    RetriveWBLink = FileSystemLibrary.GetFile(WBName.Path & "\" & WBName.Name)
    If 1 = 2 Then '99. If error
Err01RetriveWBLink:
    'this may happen for new workbooks that aren't saved yet
    RetriveWBLink = "False"
    End If '99. If error
    On Error GoTo -1
    Set FileSystemLibrary = Nothing
End Function

Вы можете попробовать что-то вроде ниже

  1. Проверьте, есть ли ссылка из открытой книги
  2. Если это используется, то используйте ChangeLink обмануть Excel в создании обновления
  3. Если нет, запустите существующий код, который работает на закрытой книге.

код

 Sub updateValues()
 Dim updFilePath As String
 Dim Wb As Workbook
 Dim bFound As Boolean

 updFilePath = ActiveWorkbook.Sheets("INPUTS").Range(updCellRef).Value

 For Each Wb In Application.Workbooks
 If Wb.FullName = updFilePath Then
    ActiveWorkbook.ChangeLink Wb.Name, Wb.Name
    bfound = True
    Exit For
 End If
 Next

 If Not bfound Then ActiveWorkbook.UpdateLink Name:=updFilePath, Type:=xlExcelLinks
End Sub

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

Dim wb as Workbook
Set wb = Excel.Workbooks.Open(Filename)

updFilePath = wb.Sheets("INPUTS").Range(updCellRef).Value
wb.Close

Я понимаю вашу точку зрения, что если электронная таблица совпадает с именем вашей открытой электронной таблицы, она будет рваться. Может быть, простой взлом состоит в том, чтобы захватить имя файла активной книги, сохранить его как временный файл, а затем сохранить его обратно в самом конце. Я сказал, что это был взлом.

Я знаю, что вы можете получить доступ к данным Spreadsheet, например, к базе данных, используя ADO через C# или MS Access, поэтому я предполагаю, что это также возможно сделать прямо из Excel. Тем не менее, это вряд ли кажется менее взломать, чем предложение выше. Я думаю, что ADO также должен прочитать всю электронную таблицу, даже чтобы обработать одну ячейку, так что я не думаю, что это все равно что-нибудь спасет.

Другие вопросы по тегам