VBA Excel - SaveCopyAs 方法破坏了所有超链接答案

【问题标题】：VBA Excel - SaveCopyAs method is breaking all HyperlinksVBA Excel - SaveCopyAs 方法破坏了所有超链接
【发布时间】：2021-05-03 07:14:55
【问题描述】：

我有一个问题一直在尝试解决，但没有运气......！

我有一个备份代码，它使用 application.savecopyas 方法保存电子表格的副本。

问题是，一旦运行此操作，整个工作簿中的所有超链接都将变为无效，因为路径的一部分已被删除。比如这样：

正确的路径 - file:///\servername\department\project\model\site\comms\filename.pdf

不正确的路径 - file:///\servername\department\project\comms\filename.pdf

只有在运行以下代码行时才会出现问题：

ActiveWorkbook.SaveCopyAs FileName:=FullFileName

其中 FullFileName 在前面的代码中由以下人员定义：

FullFileName = FolderPath & "\" & Format(Now, "yyyy-mm-dd_hh-mm-ss") & " - " & FileName & "." & FileExt

知道为什么 SaveCopyAs 会以这种奇怪的方式影响我的超链接吗？

-

更多信息 - 修复代码也做了类似的事情：

我还有一个修复代码来修复损坏的链接，本质上这是获取文件名并手动组合正确的文件夹名称和文件名并将其分配给每个超链接。

我也注意到了这一点，有时会忽略文件路径的一部分，有时会起作用，有时不会。我不会在两次运行之间更改代码中的任何内容。

Sub HyperlinkFix_FromCustomer()

    j = 0
    Dim GetURL As String
    For j = 3 To 1000
    
        If IsEmpty(Cells(j, 2)) = False Then
            On Error Resume Next
            
            LinkAddress = Sheets("From Customer").Range("B" & j).Hyperlinks(1).Address
            
            If Cells(j, 2).Hyperlinks.Count < 1 Then
                'MsgBox j
                GoTo Next1
            End If
            
            'Sheets("From Customer").Range("W" & j).Value = linkAddress
            
            Inputstring = LinkAddress
            'InputString = Sheets("From Customer").Range("W" & j).Value
            
            I = 0
            
            While InStr(I + 1, Inputstring, "\") > 0
                I = InStr(I + 1, Inputstring, "\")
                
            Wend
            
            
            'Extract the folder path
            'If No occurence of path separator is found then assign the default directory path
            If I = 0 Then
                FolderName = "Error - No Folder"
            Else
                FolderName = Left(Inputstring, I - 1)
            End If
            
            'Extracting the file name
            FileName = Right(Inputstring, Len(Inputstring) - I)
            YearStr = Right(Inputstring, Len(Inputstring) - I + 5)
            YearStr = Left(YearStr, 4)
            
            NewDIR = "department\Project\model\site\comms\"
            NewDIR = GETNETWORKPATH("D:") & "\" & NewDIR
            
            
            
            CorrectAddress = NewDIR & "\" & YearStr & "\" & FileName
                                                             
            Sheets("From Saab").Hyperlinks.Add Anchor:=Sheets("From customer").Range("B" & j), Address:=CorrectAddress, TextToDisplay:=Sheets("From customer").Range("B" & j).Value
            
            
            
        End If
Next1:
    Next j

End Sub

【问题讨论】：

superuser.com/questions/649192/… 我认为这可能是相关的，但是我并不完全理解解决方案。

标签： excel vba hyperlink

【解决方案1】：

我刚刚找到了解决这个问题的方法。转到文件 --> 信息 --> 显示所有属性 --> 超链接库

在那里写你的驱动器，例如

C:\

【讨论】：