Adavid02
Adavid02

Reputation: 189

Excel Hyperlinks - Link to Files breaking

I use a code to extract file paths in order to link entries in an Excel document to their original file. The code works fine except for the links do not work, and it's not because of the code. The reason I know is that there is only one method of hyperlinking that always works. I know it is not caused by invalid characters because I have code that remove specified characters and renames the file. It also doesnt matter if I remove them manaually before hyperlinking. I would like to know what the issue is so that I can get my code to work.

File path extracted via code: \SRV006#SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\DFWS added to DFW Track\DFW and PO 1234567.pdf

Hovering over hyperlink, this path is displayed: file:///\SRV006\ - SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\ DFWS added to DFW Track\ DFW and PO 1234567.pdf

File path shown via right click, “Edit Hyperlink”: \SRV006#SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\DFWS added to DFW Track\DFW and PO 1234567.pdf

Link copied as path and pasted (also tested in Word Document): "\SRV006#SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\DFWS added to DFW Track\DFW and PO 1234567.pdf"

If added in “Add Hyperlink” dialog box, the path still does not work: \SRV006#SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\DFWS added to DFW Track\DFW and PO 1234567.pdf

THIS IS THE ONLY HYPERLINK THAT ACTUALLY WORKS.

Link path that works after manually hyperlinking via right-click add hyperlink: 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 '\'
    ' 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

Upvotes: 0

Views: 491

Answers (1)

Adavid02
Adavid02

Reputation: 189

I solved this by removing the "#SRV006\" so that the path is

"\SRV006\Am\Master Documents\PC 2.2.11t Document For Work(DFWs) \DFWS added to DFW Track\"

The code snippet below is a part of a code that opens a PDF in Acrobat Reader, removes bad characters from a file name, copies the data into a UserForm which allows the User to review the data before adding it to the document, then with a CommandButton adds the data to the document, and hyperlinks the document name to the original file.

Here is my code snippet. Then using the new file path for my hyperlink. If you only want to remove a bad part of the path use Option 2.

Option 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

Option 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

Upvotes: 1

Related Questions