Обновление гиперссылки на файл при перемещении файла в другую папку

#excel #vba #hyperlink

#excel #vba #гиперссылка

Вопрос:

У меня есть файлы в двух папках, которые перемещаются вручную между собой. Файл Excel содержит список всех имен файлов в этих двух папках в столбце C.

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

Как мне добавить другой путь к файлу в коде и как я должен его обновить.

 Option Explicit

Private Sub CommandButton1_Click()
Dim cell As Range

For Each cell In Range(Range("C3"), Range("C3").End(xlDown))
    ActiveSheet.Hyperlinks.Add cell, "Y:training" amp; cell.Value amp; ".xlsm"
Next

End Sub
 

Ответ №1:

Создание гиперссылок на файлы

 Option Explicit

Private Sub CommandButton1_Click()
    
    Const Extension As String = ".xlsm"
    Dim FolderPaths As Variant
    FolderPaths = Array( _
        "Y:Training", _
        "Y:Sleeping")
    
    Dim cell As Range
    Dim FolderPath As Variant
    Dim FilePath As String

    For Each cell In Range(Range("C3"), Range("C" amp; Rows.Count).End(xlUp))
        If Len(cell.Value) > 0 Then
            For Each FolderPath In FolderPaths
                FilePath = FolderPath amp; cell.Value amp; Extension
                If Dir(FilePath) <> "" Then
                    ActiveSheet.Hyperlinks.Add cell, FilePath
                    Exit For
                End If
            Next FolderPath
        End If
    Next

End Sub
 

Комментарии:

1. Огромное спасибо!!!!………….. Это работает как заклинание!