Excel超链接 – 链接到文件打破

我使用代码来提取文件path,以便将Excel文档中的条目链接到其原始文件。 代码工作正常除了链接不工作,这不是因为代码。 我知道的原因是只有一个超链接的方法总是有效的。 我知道这不是由无效字符引起的,因为我有删除指定字符并重命名文件的代码。 如果我在超链接之前将其移除,那么也无关紧要。 我想知道是什么问题,以便我的代码可以工作。

通过代码提取的文件path:\ SRV006#SRV006 \ Am \ Master Documents \ PC 2.2.11 Document For Work(DFWs)\ DFWS添加到DFW Track \ DFW和PO 1234567.pdf

将鼠标hover在超链接上,将显示以下path:file:/// \ SRV006 \ – SRV006 \ Am \ Master Documents \ PC 2.2.11 Document For Work(DFWs)\ DFWS添加到DFW Track \ DFW和PO 1234567.pdf

通过右键单击“编辑超链接”显示的文件path:\ SRV006#SRV006 \ Am \ Master Documents \ PC 2.2.11 Document For Work(DFWs)\ DFWS添加到DFW Track \ DFW和PO 1234567.pdf

链接复制为path并粘贴(也在Word文档中testing):“\ SRV006#SRV006 \ Am \ Master Documents \ PC 2.2.11 Document For Work(DFWs)\ DFWS添加到DFW Track \ DFW和PO 1234567.pdf”

如果在“添加超链接”对话框中添加,path仍然不起作用:\ SRV006#SRV006 \ Am \ Master Documents \ PC 2.2.11 DFW文件\ DFWS添加到DFW Track \ DFW和PO 1234567.pdf

这是实际上唯一的超级链接。

通过右键单击添加超链接手动超链接后的链接path:DFWS%20added%20to%20DFW%20Track \ DFW%20and%20PO%201234567.pdf

'Functions that gets the FileName from the path: Function GetFilenameFromPath(ByVal strPath As String) As String ' Returns the rightmost characters of a string upto but not including the rightmost '\' ' eg 'c:\winnt\win.ini' returns 'win.ini' If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1) End If End Function 'Function that replaces Bad Characters and renames the file. Function Replace_Filename_Character(ByVal Path As String, _ ByVal OldChr As String, ByVal NewChr As String) Dim FileName As String 'Input Validation 'Trailing backslash (\) is a must If Right(Path, 1) <> "\" Then Path = Path & "\" 'Directory must exist and should not be empty. If Len(Dir(Path)) = 0 Then Replace_Filename_Character = "No files found." Exit Function 'Old character and New character must not be empty or null strings. ElseIf Trim(OldChr) = "" And OldChr <> " " Then Replace_Filename_Character = "Invalid Old Character." Exit Function ElseIf Trim(NewChr) = "" And NewChr <> " " Then Replace_Filename_Character = "Invalid New Character." Exit Function End If FileName = Dir(Path & "*.*") 'Use *.xl* for Excel and *.doc for Word files Do While FileName <> "" Name Path & FileName As Path & Replace(FileName, OldChr, NewChr) FileName = Dir Loop Replace_Filename_Character = "Ok" End FunctionSnippet Renaming the file: 'Rename the file Dim Ndx As Integer Dim FName As String, strPath As String Dim strFileName As String, strExt As String Const BadChars = "@!$/'<|>*- — " ' put your illegal characters here If Right$(vrtSelectedItem, 1) <> "\" And Len(vrtSelectedItem) > 0 Then FilenameFromPath = GetFilenameFromPath(Left$(vrtSelectedItem, Len(vrtSelectedItem) - 1)) + Right$(vrtSelectedItem, 1) End If FName = FilenameFromPath For Ndx = 1 To Len(BadChars) FName = Replace$(FName, Mid$(BadChars, Ndx, 1), "_") Next NdX GivenLocation = _ "\\SRV006\#SRV006\Am\Master Documents\PC 2.2.11 Document For Work(DFWs) \DFWS added to DFW _ Track\" 'note the trailing backslash OldFileName = vrtSelectedItem NewFileName = GivenLocation & FName & strExt strExt = ".pdf" On Error Resume Next Name OldFileName As NewFileName On Error GoTo 0 Sheet7.Range("a50").Value = NewFileName 'pastes new file name into cellA UserForm looks at filepath that was extracted and uses that as the filepath for the hyperlink, and a textbox on the UserForm as the text to display on the hyperlink. 'UserForm Snippet that links the filepath to the the entry: Sheet1.Hyperlinks.Add _ Anchor:=LastRow.Offset(1, 0), _ Address:=TextBox19.Value, _ TextToDisplay:=TextBox1.Value 

我通过删除“#SRV006 \”来解决这个问题

“\ SRV006 \ Am \ Master Documents \ PC 2.2.11t Work For Work(DFWs)\ DFWS添加到DFW Track \”

下面的代码片段是在Acrobat Reader中打开PDF的代码的一部分,从文件名中删除不良字符,将数据复制到UserForm中,用户可以在将数据添加到文档之前查看数据,然后使用CommandButton将数据添加到文档,并将文档名称超链接到原始文件。

这是我的代码片段。 然后为我的超链接使用新的文件path。 如果您只想删除path中不好的部分,请使用选项2。

选项1:

 'Rename the file Dim FPath As String Dim Ndx As Integer Dim FName As String, strPath As String Dim strFileName As String, strExt As String Dim NewFileName As String Const BadChars = "@!$/'<|>*-—" ' put your illegal characters here If Right$(vrtSelectedItem, 1) <> "\" And Len(vrtSelectedItem) > 0 Then FilenameFromPath = GetFilenameFromPath(Left$(vrtSelectedItem, Len(vrtSelectedItem) - 1)) + Right$(vrtSelectedItem, 1) End If FName = FilenameFromPath For Ndx = 1 To Len(BadChars) DoEvents FName = Replace$(FName, Mid$(BadChars, Ndx, 1), "_") DoEvents Next Ndx GivenLocation = _ "\\SRV006\Am\Master Documents\PC 2.2.11 Document For Work(DFWs)\DFWS added to DFW Track\" 'note the trailing backslash OldFileName = vrtSelectedItem strExt = ".pdf" NewFileName = GivenLocation & FName & strExt Name vrtSelectedItem As NewFileName Sheet8.Range("a50") = NewFileName 'pastes new file name into cell Next vrtSelectedItem 

选项2:

  'Replace vrtSelectedItem with your file path. vrtSelectedItem is where my file path is. Dim FPath As String FPath = vrtSelectedItem 'Fixing the File Path FPath = (Right(FPath, Len(FPath) - InStr(FPath, "#"))) FPath = "\\" & FPath