Excel超链接 - 链接到文件中断

时间:2014-07-30 15:48:27

标签: excel vba hyperlink

我使用代码提取文件路径,以便将Excel文档中的条目链接到其原始文件。代码工作正常,除了链接不起作用,它不是因为代码。我知道的原因是只有一种超链接方法总是有效。我知道它不是由无效字符引起的,因为我有删除指定字符的代码并重命名该文件。如果我在超链接之前手动删除它们也没关系。 我想知道问题是什么,以便我可以让我的代码工作。

通过代码提取的文件路径: \ SRV006#SRV006 \ Am \ Master Documents \ PC 2.2.11工作文件(DFW)\ DFWS添加到DFW Track \ DFW和PO 1234567.pdf

将鼠标悬停在超链接上会显示以下路径: file:/// \ SRV006 \ - SRV006 \ Am \ Master Documents \ PC 2.2.11工作文件(DFW)\ DFWS添加到DFW Track \ DFW和PO 1234567.pdf

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

链接复制为路径并粘贴(也在Word文档中测试): " \ SRV006#SRV006 \ Am \ Master Documents \ PC 2.2.11工作文档(DFW)\ DFWS添加到DFW Track \ DFW和PO 1234567.pdf"

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

这是唯一可行的超级链接。

通过右键单击添加超链接手动超链接后工作的链接路径: DFWS%20added%20to%20DFW%20Track \ DFW%20于是%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 '\'
    ' e.g. '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

1 个答案:

答案 0 :(得分:1)

我通过删除&#34;#SRV006 \&#34;解决了这个问题。所以路径是

&#34; \ SRV006 \ Am \ Master Documents \ PC 2.2.11t工作文件(DFW)\ DFWS添加到DFW Track \&#34;

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

这是我的代码段。然后使用我的超链接的新文件路径。如果您只想删除路径中的坏部分,请使用选项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