Word 2002 macro error

[Mark]

I've noticed the failure of several macros recently, they worked perfectly
for years under Word 2000 and have stopped with Word 2002. No idea why.

This macro is typical. It stops at rf.Path with Runtime error 5152: Method
'path' of object 'RecentFile' failed. When in debug mode, 'Fullname' contains
the full file name/path of the first RecentFile so I don't see how rf.Path
and rf.Name have failed!

---
Sub CleanRecentFileList()
' Cleans history on file menu
' if file cannot be seen, it is removed from the list.

Dim rf As RecentFile, FullName As String
Const CLEARABSENTNETDOCS As Boolean = False
' Change to True to delete docs on absent network drives
Const CLEARABSENTREMOVABLES As Boolean = True
' Change to False to retain docs on absent removable drives
For Each rf In RecentFiles
FullName = rf.Path & Application.PathSeparator & rf.Name ' Fails here!

If FullName = Application.PathSeparator And CLEARABSENTNETDOCS Then
' Probably absent network drive
rf.Delete
Else
On Error Resume Next
' VBA raises error if file is on absent removable disk
If Dir(FullName) = "" Then
If (Err.Number <> 0 And CLEARABSENTREMOVABLES) Or (Err.Number = 0)
Then
rf.Delete
End If
Err.Clear
End If
On Error GoTo 0 ' Reinstate normal VBA error handling
End If
Next
End Sub

 

[Travis N]

I'm also having a similar problem / same error. With some experimenting I
have found that if the path contains any spaces I get the error, If it does
not, I don't get an error... However, I still havn't figured out how to fix
the problem (short of making sure all folder names don't contain spaces)

 

[Travis N]

Just an update..

I solved my problem, but I don't know if it will help Mark..

It turns out that the spaces in tha path name had nothing to do with my
problem; it was just a coincedince that the path that didn't exist also had
spaces in it. My code was suppose to determine if the path exixts, create
the path if it didn't exist, and then save a copy of the document to the path
(the path was determined according to coded file name) for all files in a
certian directory.

The solution was to check to see if each folder in the path existed
incrimentally, add any needed folders incramentally, and then save the
document once the path was confirmed or created.

Here is the code:


Sub Print_and_Save()
'
' Macro by Travis Nyberg, DC
'
Dim Response
Set fs = Application.FileSearch
With fs
.LookIn = "E:\Macro's\trans"
.SearchSubFolders = True
.FileName = "*.*"
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
Response = MsgBox("Saving " & .FoundFiles(i), vbYesNo +
vbDefaultButton1, "Confirm Print!")
If Response = vbYes Then ' User chose Yes.
'Application.PrintOut FileName:=.FoundFiles(i), _
' Copies:=3, Collate:=False
'Save file with new extension
Dim CurrentDoc As Word.Document
Set CurrentDoc = Documents.Open(.FoundFiles(i), , , False, ,
, , , , , , True)

Dim strDocName, strTherName As String
Dim intPos, intMonth As Integer

'Find position of extension in filename
strDocName = CurrentDoc.Name
intPos = InStrRev(strDocName, ".")

If intPos = 0 Then

'If the document has not yet been saved
'Ask the user to provide a filename
strDocName = InputBox("Please enter the name " & _
"of your document.")
Else

'Strip off extension and add ".doc" extension
strDocName = Left(strDocName, intPos - 1)
strDocName = strDocName & ".doc"
End If

'Create SaveAs Path
strTherName = Left(strDocName, 2)
Select Case strTherName
Case "TN"
strTherName = "Nyberg"
Case "SC"
strTherName = "Colling"
Case "SK"
strTherName = "Kitzhaber"
Case "TH"
strTherName = "Hoffman"
Case Else
strTherName = InputBox("Please Enter the Last Name
for " & strTherName)
End Select

intMonth = Val(Mid(strDocName, 3, 2))
While intMonth < 1
intMonth = Val(InputBox("Please enter Month Number of
Dictation [1-12]"))
Wend

Dim intCurrentMonth, intCurrentYear
intCurrentMonth = Val(Left(Date$, 2))
intCurrentYear = Val(Right(Date$, 4))
' Correct Year if Month of previous year
If intCurrentMonth < intMonth Then
intCurrentYear = intCurrentYear - 1
End If

Dim strSaveDocumentPath As String
strSaveDocumentPath =
"E:\Macro's\WAP\OCC_HEALTH_TRANSCRIPTION\" & CStr(MonthName(intMonth, True))
& "_" & CStr(intCurrentYear) & "_Dictation\WAP_" & CStr(MonthName(intMonth))
& "\" & strTherName & "_" & CStr(MonthName(intMonth)) & "\"

Dim SearchString, SearchChar, SearchReturnPos
SearchString = strSaveDocumentPath ' String to search in.
SearchChar = "\" ' Search for "\".
SearchReturnPos = 1

On Error GoTo Er
Dim PthNotExist As Boolean ' A Boolean’s initial value =
False

While SearchReturnPos > 0
SearchReturnPos = InStr(SearchReturnPos, SearchString,
SearchChar, 1)
'If Left$(CurDir, 2) <> "E:" Then
' ChDrive "E:"
'End If
' If the path does not exist, the error haldler will be
invoked with error #76.
ChDir Left(strSaveDocumentPath, SearchReturnPos - 1)
If PthNotExist Then ' This will have been set in
the error handler
MkDir Left(strSaveDocumentPath, SearchReturnPos - 1)
MsgBox "Path Created:" & vbCrLf &
Left(strSaveDocumentPath, SearchReturnPos - 1)
End If
If SearchReturnPos > 0 Then
If SearchReturnPos < Len(SearchString) Then
SearchReturnPos = SearchReturnPos + 1
Else
SearchReturnPos = 0
End If
End If
Wend
PthNotExist = False ' Re-initialize the value, if it
is not going to be used to take additional action.

MsgBox "Note for: " & MonthName(intMonth, True) & "/" &
intCurrentYear & vbCrLf & strSaveDocumentPath _


'Save file with new extension
' H:\OCC HEALTH TRANSCRIPTION\Apr 2005 Dictation\WAP
April\Nyberg April
'If "" Then
CurrentDoc.SaveAs FileName:=strSaveDocumentPath &
strDocName, _
FileFormat:=wdFormatDocument

CurrentDoc.Close
End If
Next i
Else
MsgBox "There were no files found."
End If
End With

Rs: Exit Sub
Er: If Err.Number = 76 Then ' Path Not Found
PthNotExist = True
Resume Next
End If
'If Err.Number = 75 Then ' Path Not Found
' MsgBox "Default Path / Folder is not Valid;" & vbCrLf & _
' "Please select a valid directory!"
' CurrentPath = Dialogs(wdDialogFileOpen).Show
' PthNotExist = True
' Resume Next
'End If

MsgBox "Error " & Err.Number & ", """ & Err.Description & """"
Resume Rs

End Sub



Good Luck!

-Travis