Hi Bo,
To answer your original questions:
1. There is no field construction or switch in any version of Word that can
return just the path without the filename, and I can't think of any
reasonable way to get one. There is a function available in a macro,
WordBasic.FileNameInfo$(ActiveDocument.Name, 5), that can do that, but there
isn't any way to call that function from a field. You would have to run a
macro to replace the field result with the value returned by the
FileNameInfo function, and that wouldn't be automatic. If you want to chase
this some more, start a thread in microsoft.public.word.vba.beginners.
2. There is also no way to get a field to translate mapped drive letters to
UNC format (\\Server\share\...) There's nothing built into VBA, either --
you have to delve into the fascinating world of Windows 32 API programming.
To give you an idea of just what you're asking, here's a macro that will
replace any {FILENAME \p} field with a {QUOTE} field containing the file's
UNC name. Again, if you want to pursue this, move the discussion to the vba
newsgroup.
Declare Function WNetGetConnection Lib "mpr.dll" _
Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, _
cbRemoteName As Long) As Long
' Use for the return value of WNetGetConnection() API.
Const NO_ERROR As Long = 0
' The size used for the string buffer. Adjust this if you
' need a larger buffer.
Const lBUFFER_SIZE As Long = 255
Sub ShowNetPath()
Dim oStory As Range, oRg As Range
Dim oFld As Field
Dim vbQuote As String
Dim lpNewPath As String
vbQuote = """"
' Loop through all StoryRanges in the doc
For Each oStory In ActiveDocument.StoryRanges
' Loop through all fields in this StoryRange
For Each oFld In oStory.Fields
With oFld
' See if this is a {FILENAME \p} field
If (.Type = wdFieldFileName) And _
(InStr(LCase(.Code.Text), "\p") > 0) Then
' Get the UNC equivalent if any
lpNewPath = UNCRemotePath(.Result.Text)
' The QUOTE field needs each backslash
' to be doubled.
lpNewPath = Replace(lpNewPath, "\", "\\")
' Replace the field code
.Code.Text = "QUOTE " & vbQuote & _
lpNewPath & vbQuote
' Update it
.Update
End If
End With
Next oFld
' For headers/footers, textboxes, etc.
' repeat through all linked StoryRanges.
Do While Not oStory.NextStoryRange Is Nothing
Set oStory = oStory.NextStoryRange
For Each oFld In oStory.Fields
With oFld
If (.Type = wdFieldFileName) And _
(InStr(LCase(.Code), "\p") > 0) Then
lpNewPath = UNCRemotePath(.Result.Text)
lpNewPath = Replace(lpNewPath, "\", "\\")
.Code.Text = "quote " & vbQuote & _
lpNewPath & vbQuote
.Update
End If
End With
Next oFld
Loop
Next oStory
End Sub
Private Function UNCRemotePath(lpFileName As String) As String
Dim lpDrive As String, lpszRemoteName As String
Dim cbRemoteName As Long, lStatus As Long
If (Not (UCase(Left$(lpFileName, 1)) Like "[A-Z]")) Or _
(Mid$(lpFileName, 2, 1) <> ":") Then
' lpFileName doesn't start with a drive letter.
' Return the input string unchanged.
UNCRemotePath = lpFileName
Exit Function
End If
lpDrive = Left$(lpFileName, 2)
' Prepare a string variable by padding spaces
lpszRemoteName = lpszRemoteName & Space(lBUFFER_SIZE)
cbRemoteName = lBUFFER_SIZE
' Get the UNC path (\\Server\Share) if any
lStatus& = WNetGetConnection(lpDrive, lpszRemoteName, _
cbRemoteName)
' WNetGetConnection() returns 0 (NO_ERROR)
' if it succesfully retrieves the UNC path.
' It returns a different value if the drive is
' not mapped or if the input is invalid.
If lStatus& = NO_ERROR Then
' The unpadded part of lpszRemoteName ends with
' a zero byte that must be removed.
lpszRemoteName = Left$(lpszRemoteName, _
InStr(lpszRemoteName, Chr$(0)) - 1)
' Replace the drive letter with the UNC path
UNCRemotePath = lpszRemoteName & _
Right$(lpFileName, Len(lpFileName) - 2)
Else
' Unable to obtain the UNC path, so
' return input unchanged.
UNCRemotePath = lpFileName
End If
End Function
