Path in footer using UNC

[Eric]

Hello,

I was given by Norman H. this macro to add the path and filename of the
workbook in the footer:

Private Sub Workbook_BeforePrint(Cancel As Boolean)

ActiveSheet.PageSetup.LeftFooter = ActiveWorkbook.FullName

End Sub


This routine works great but is there a way to force a UNC format when
writing the path?

Thank you.


Eric.

 

[Jim Rech]

You can get the UNC path by passing the Fullname to the function
MakeUNC_Path.

For example:

Sub test()
MsgBox MakeUNC_Path("g:\apdv\fsc\book3.xls")
End Sub

Function MakeUNC_Path(FullFileName As String) As String
Dim UNC_Drive As String
UNC_Drive = GetUNCPathFromDriveLetter(Left(FullFileName, 1))
If UNC_Drive = "" Then
MakeUNC_Path = FullFileName
Else
MakeUNC_Path = Left(UNC_Drive, Len(UNC_Drive) - 1)
MakeUNC_Path = MakeUNC_Path & Mid(FullFileName, 3)
End If
End Function

Function GetUNCPathFromDriveLetter(Driveletter As String) As String
Dim cbRemoteName As Long
Dim lStatus As Long
Dim lpszRemoteName As String
Dim lSize As Long
Driveletter = Driveletter & ":"
cbRemoteName = lBUFFER_SIZE
lpszRemoteName = lpszRemoteName & Space(lBUFFER_SIZE)
lStatus = WNetGetConnection32(Driveletter, lpszRemoteName, _
cbRemoteName)
If lStatus = NO_ERROR Then
GetUNCPathFromDriveLetter = _
Left(lpszRemoteName, InStr(1, lpszRemoteName, Chr(0)))
End If
End Function

 

[Jonathan Rynd]

This routine works great but is there a way to force a UNC format when
writing the path?

ActiveWorkbook.FullName is just a string. If you know that the H: drive is
always \\WORKGROUPSERVER, store the activeworkbook.fullname in a temporary
variable and make that change to the string.