Word macro running from OL VBA throwing error on Word SaveAs??

  • Thread starter Thread starter Ed from AZ
  • Start date Start date
E

Ed from AZ

I have a macro in Word that iterates through my Favorites folder and
saves everything out as hyperlinks in a Word doc. I then SaveAs using
doc.SaveAs FileName:= _
"C:\Documents and Settings\edward.millis\Documents\MyFaves.htm",
_
FileFormat:=wdFormatHTML

This macro was written in Word XP, which has now been upgraded to
2007. The OS has also been updated from WinXP Pro to Vista Pro.

When I run the macro in Word only, it runs fine - the file is
generated and saved to the correct folder in the correct format.

I want to email the file out, so I am trying to run it from within an
Outlook 2007 macro. (Security settings prevent Word VBA from
accessing OL VBA, or I would do it all from within Word.)

The OL macro creates the Word instance just fine and runs the macro
just fine - until it hits the SaveAs. I put a STOP in the Word code
just before the SaveAs to verify this - as soon aas I F8 to the
SaveAs, my error handler tells me that Outlook VBA has the following
error:
-2147417851
Method "Run" of object "Application" failed

Any suggestions on getting this macro to run when accessed from OL
VBA?
Ed
 
That file path shouldn't exist at all on a Vista system. Does the exact same
code really run in Word on Vista without errors? In any case, if there's a
Word error going on the problem isn't an Outlook problem but a Word problem.
 
That file path shouldn't exist at all on a Vista system.

Wow! I copied it straight off the folder address bar - I thought.
The address bar shows the heirarchy separated by >, but when you click
in it it turns to /. I'll have to look at that again. But yes, when
run from Word, there are no problems. Well, maybe not - it's
overwriting a file that's already there, so maybe the newly save file
is disappearing into the system somewhere and I'm actually still
seeing the previous version.

Gotta look at that again! Thanks, Ken. At least I have a good point
to start looking.
Ed
 
I don't know, your setup may be different, but here on one of my Vista
setups a document in my Documents folder has a path that looks like this:
C:\Users\Ken Slovak.000\Documents\9096xcc.doc.




Ed from AZ said:
That file path shouldn't exist at all on a Vista system.
Click to expand...

Wow! I copied it straight off the folder address bar - I thought.
The address bar shows the heirarchy separated by >, but when you click
in it it turns to /. I'll have to look at that again. But yes, when
run from Word, there are no problems. Well, maybe not - it's
overwriting a file that's already there, so maybe the newly save file
is disappearing into the system somewhere and I'm actually still
seeing the previous version.

Gotta look at that again! Thanks, Ken. At least I have a good point
to start looking.
Ed
 
Vista will allow you to use that name as an alternative to the
Users\(userid)\Documents name.

Are you using Application.Run (as per the message)? Or is the code exactly
as posted - which ought to work (assuming doc is a valid reference)?

--
Enjoy,
Tony

www.WordArticles.com
 
Hi, Tony.

The Outlook macro has

'Set Word application to running instance or new instance
Set appWord = GetObject(, "Word.Application")
If Err Then
Set appWord = New Word.Application
WordWasNotRunning = True
End If
Err.Clear

On Error GoTo BadBoy

'Run Word macro
appWord.Visible = True
appWord.Run "Normal.Module11.GetMyFaves"

The Word macro does run. I put a Stop right before the SaveAs command
in the Word macro and fixed the file path for Vista. The macro breaks
at the Stop, and as soon as I F8 to the SaveAs line it throws the
error - not in the Word app, but in the OL app as described in my
first post.

I'm thinking the next step may be to put everything in OL VBA and just
access Word from there to create and save the doc. Just haven't had
time to play with that yet.

Ed
 
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

www.WordArticles.com

Hi, Tony.

The Outlook macro has

'Set Word application to running instance or new instance
Set appWord = GetObject(, "Word.Application")
If Err Then
Set appWord = New Word.Application
WordWasNotRunning = True
End If
Err.Clear

On Error GoTo BadBoy

'Run Word macro
appWord.Visible = True
appWord.Run "Normal.Module11.GetMyFaves"

The Word macro does run. I put a Stop right before the SaveAs command
in the Word macro and fixed the file path for Vista. The macro breaks
at the Stop, and as soon as I F8 to the SaveAs line it throws the
error - not in the Word app, but in the OL app as described in my
first post.

I'm thinking the next step may be to put everything in OL VBA and just
access Word from there to create and save the doc. Just haven't had
time to play with that yet.

Ed
 
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
 
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

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
 
Back
Top