FILENAMEフィールドのディレクトリを制限する（Microsoft Word）

{ FILENAME /p }

C:\My Documents and Settings\Level1\Level2\Level3\Level4\Doc1.docx

\Level2\Level3\Level4\Doc1.docx \Level1\Level2\Level3\Level4\Doc1.docx

Sub SelectPaths()

Dim sPath As String     Dim sName As String     Dim sFull As String     Dim sPart As String     Dim sMsg As String     Dim sTemp As String     Dim iLevels As Integer     Dim J As Integer

sPath = ActiveDocument.Path     If sPath = "" Then         MsgBox "Need to save before running this macro.", _           vbOKOnly, "This Document Not Saved"

Else         sPath = sPath & Application.PathSeparator         sName = ActiveDocument.Name         sFull = sPath & sName

sMsg = "This is the full path:" & vbCrLf         sMsg = sMsg & sFull & vbCrLf & vbCrLf         sMsg = sMsg & "How many levels do you want, counting "

sMsg = sMsg & "from right to left?"



sTemp = InputBox(sMsg)

iLevels = Val(sTemp)



sPart = ""

If iLevels > 0 Then             For J = Len(sFull) To 1 Step -1                 If Mid(sFull, J, 1) = Application.PathSeparator Then                     iLevels = iLevels - 1                     If iLevels = 0 Then                         sPart = Mid(sFull, J, 255)

Exit For                     End If                 End If             Next J         End If

Selection.TypeText (sPart)

End If End Sub

C:\My Documents and Settings\Level1\Level2\Level3\Level4\Doc1.docx