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:</SPAN>
\\SRV006\#SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\DFWS added to DFW Track\DFW and PO 1234567.pdf</SPAN></SPAN>
Hovering over hyperlink, this path is displayed:</SPAN>
file:///\\SRV006\ - SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\ DFWS added to DFW Track\ DFW and PO 1234567.pdf
</SPAN></SPAN>
File path shown via right click, “Edit Hyperlink”:</SPAN></SPAN>
\\SRV006\#SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\DFWS added to DFW Track\DFW and PO 1234567.pdf</SPAN>
Link copied as path and pasted (also tested in Word Document):</SPAN>
"\\SRV006\#SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\DFWS added to DFW Track\DFW and PO 1234567.pdf"</SPAN>
If added in “Add Hyperlink” dialog box, the path still does not work:</SPAN>
\\SRV006\#SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\DFWS added to DFW Track\DFW and PO 1234567.pdf</SPAN>
THIS IS THE ONLY HYPERLINK THAT ACTUALLY WORKS.
Link path that works after manually hyperlinking via right-click add hyperlink:</SPAN>
DFWS%20added%20to%20DFW%20Track\DFW%20and%20PO%201234567.pdf
Functions that gets the FileName from the path:</SPAN>
Function that replaces Bad Characters and renames the file.
Snippet Renaming the file:
A 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:
I would like to know what the issue is so that I can get my code to work.
File path extracted via code:</SPAN>
\\SRV006\#SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\DFWS added to DFW Track\DFW and PO 1234567.pdf</SPAN></SPAN>
Hovering over hyperlink, this path is displayed:</SPAN>
file:///\\SRV006\ - SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\ DFWS added to DFW Track\ DFW and PO 1234567.pdf
</SPAN></SPAN>
File path shown via right click, “Edit Hyperlink”:</SPAN></SPAN>
\\SRV006\#SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\DFWS added to DFW Track\DFW and PO 1234567.pdf</SPAN>
Link copied as path and pasted (also tested in Word Document):</SPAN>
"\\SRV006\#SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\DFWS added to DFW Track\DFW and PO 1234567.pdf"</SPAN>
If added in “Add Hyperlink” dialog box, the path still does not work:</SPAN>
\\SRV006\#SRV006\Am\Master Documents\PC 2.2.11 Document For Work (DFWs)\DFWS added to DFW Track\DFW and PO 1234567.pdf</SPAN>
THIS IS THE ONLY HYPERLINK THAT ACTUALLY WORKS.
Link path that works after manually hyperlinking via right-click add hyperlink:</SPAN>
DFWS%20added%20to%20DFW%20Track\DFW%20and%20PO%201234567.pdf
Functions that gets the FileName from the path:</SPAN>
Code:
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.
Code:
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 Function
Snippet Renaming the file:
Code:
'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 cell
A 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:
Code:
Sheet1.Hyperlinks.Add _
Anchor:=LastRow.Offset(1, 0), _
Address:=TextBox19.Value, _
TextToDisplay:=TextBox1.Value