Thank you for that, and sorry for the long delay in replying.
I can't see any obvious cause of your problem. I did, however, cut and paste
both your Outlook and Word codes into 2007 and I had to mess about a bit to
get it to work (some of the problems were my environment, but I did need to
add a trailing backslash on the Set objFolder line) and when I finally did I
got your error - but only once. After that I couldn't repeat the error and,
I'm sorry to say, I don't know what may be causing it.
--
Enjoy,
Tony
www.WordArticles.com
"Ed from AZ" wrote in message
...
Here's the full code in Word. It's all in one module, most variables
declared at the top, and a Sub that calls to a Function.
When I run this just in Word, it goes great, saves and closes the
doc. When I try to call this from the OL macro, it always errors out
at the SaveAs. The doc is there with all the info in it, just not
saved.
Ed
Dim fsoSysObj As FileSystemObject
Dim fdrFolder As Folder
Dim fdrSubFolder As Folder
Dim filFile As file
Dim objShell As Shell
Dim objFolder As Object
Dim objItem As Object
Dim objLink As Object
Dim doc As Document
Dim rng As Range
Dim strFldName As String
Dim myanchor, strLnkText, strLnkPath
Dim ary() As String
Dim cntAry As Integer
Dim x As Integer
'
Function GetFiles(strPath As String, _
Optional blnRecursive As Boolean) As Boolean
' This procedure returns all the files in a directory into
' an array. If called recursively, it also returns
' all files in subfolders.
On Error Resume Next
' Get folder.
Set fdrFolder = fsoSysObj.GetFolder(strPath)
' Skip this folder
If fdrFolder.Name = "~Work" Then GoTo GetFiles_End
strFldName = fdrFolder.Name
If Err 0 Then
' Incorrect path.
GetFiles = False
GoTo GetFiles_End
End If
On Error GoTo 0
Set objFolder = objShell.Namespace(strPath)
' Loop through Files collection, adding to array.
For Each filFile In fdrFolder.Files
If filFile.Type = "Internet Shortcut" Then
Set objItem = objFolder.ParseName(filFile.Name)
Set objLink = objItem.GetLink
' Set info in array
cntAry = cntAry + 1
ReDim Preserve ary(3, cntAry) As String
ary(1, cntAry) = strFldName
ary(2, cntAry) = objItem.Name
ary(3, cntAry) = objLink.Target.Path
End If
Next filFile
' If Recursive flag is true, call recursively.
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFolders
GetFiles fdrSubFolder.Path, True
Next fdrSubFolder
End If
' Return True if no error occurred.
GetFiles = True
GetFiles_End:
Exit Function
End Function
Sub GetMyFaves()
' Calls GetFiles function to retrieve Favorites URLs.
If Application.Documents.Count 1 Then Application.Documents.Add
Set doc = ActiveDocument
cntAry = 0
' Return new FileSystemObject.
Set fsoSysObj = New FileSystemObject
' Shell object provides objects with link properties
Set objShell = CreateObject("Shell.Application")
' Call recursively, return info into array.
If GetFiles("C:\Users\edward.millis\Favorites", True) Then
For x = 1 To cntAry
Set rng = doc.Paragraphs(doc.Paragraphs.Count).Range
If ary(1, x) strFldName Then
rng.Text = "\" & ary(1, x) & vbCrLf
Set rng = doc.Paragraphs(doc.Paragraphs.Count).Range
End If
strFldName = ary(1, x)
Set myanchor = rng
strLnkText = ary(2, x)
strLnkPath = ary(3, x)
doc.Hyperlinks.Add Anchor:=myanchor, Address:= _
strLnkPath, SubAddress:="", ScreenTip:="", TextToDisplay:= _
strLnkText
doc.Content.InsertAfter vbCrLf
Next x
End If
Stop
On Error Resume Next
doc.SaveAs FileName:= _
"C:\Users\edward.millis\Documents\MyFaves.htm" , _
FileFormat:=wdFormatHTML
doc.Close
If Err.Number 0 Then _
MsgBox Err.Number & ": " & Err.Description
On Error GoTo 0
End Sub
On Mar 9, 12:33 pm, "Tony Jollans" My forename at my surname dot com
wrote:
The error is in Outlook because .. you don't have any active error
trapping,
and the error bubbles up to the top and is trapped, ultimately, by the top
level VBA in Outlook. If you add an On Error to your Word macro, it should
trap the error there.
That, however, doesn't help with the actual issue - error code -2147417851
is a rather generic 'server exception' - these can be symptomatic of
object
errors - lost pointers, or implicit instantiation, for example - that can
happen in Automation. Can you post the full Word code as well?
--
Enjoy,
Tony