Excel VBA cause Word to Crash

[jkeford]

Hi,
I am somewhat new to vba and I am not sure if I am posting this in
the
right place but I can't seem to figure this one out or find a problem
that is similar in the postings.

My vba code runs in excel, which opens a word file, and then
subsequently has to access excel documents embedded in that word
file,
to copy some information back to the original excel document running
the code. After it is done, the code closes the document and then
word
(only if word was not previously running). The problem is that Word
seems to intermittently crash when I am trying to close the document
or the application.


I have thought of several reasons this may be happening. My primary
concern is this though: I do not know how change the focus/close from
the last embedded excel document once it has been activated, so I go
from that to just close the document. I wonder if what causes Word to
crash is that it is trying to hold on to the OLE connections of the
embedded excel files and takes time to release them. I had tried to
deal with this by putting a Sleep break in the program, but it still
seems to crash 1 out of about 10 times.


I have attached the code below:
========CODE============
Dim SAFileName As String
Dim strFilter As String


Dim wdApp As Object
Dim wdDoc As Object
Dim wdRunning As Boolean


Dim destXL As Excel.Workbook
Dim xlApp As Excel.Application


Dim missingObject1 As Boolean
Dim missingObject2 As Boolean


Dim updateSuccess As Boolean


Public Const pwd As String = "PlanningCycleF2008"


'Private API Functions
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As
Long)


Sub Refresh_Click()
On Error GoTo Err_Refresh_Click


Set xlApp = GetObject(, "Excel.Application")
Set destXL = ThisWorkbook


'Open the File Browser to find the document
strFilter = thAddFilterItem(CStr(strFilter), "Word Files
(*.doc)",
"*.doc")
SAFileName = thCommonFileOpenSave( _
Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
DialogTitle:="SELECT SA DOCUMENT TO LOAD FROM ... ")


'Exit if the string returned is null
If SAFileName = vbNullString Then
Set xlApp = Nothing
Set destXL = Nothing
Exit Sub
End If


Call TurnOffProtection
destXL.Sheets("WaitMsg").Visible = True
destXL.Sheets("WaitMsg").Activate


xlApp.Cursor = xlWait
xlApp.ScreenUpdating = False


'Start Word and open the file
If fIsAppRunning("Word") Then
Set wdApp = GetObject(, "Word.Application")
wdRunning = False
Else
Set wdApp = CreateObject("Word.Application")
wdRunning = True
End If


wdApp.Visible = True
wdApp.WindowState = wdWindowStateMinimize
wdApp.Resize Width:=485, Height:=227
wdApp.Move Left:=0, Top:=300
wdApp.ScreenUpdating = False
Set wdDoc = wdApp.Documents.Open(SAFileName)


wdApp.System.Cursor = wdCursorWait


'Check to make sure both objects are there
If DoesNotExist("IT_ResourceEstimates") Then
MsgBox "IT Resource Estimate is missing from SA document!"
missingObject1 = True
Else
missingObject1 = False
End If


If DoesNotExist("IT_CostEstimates") Then
MsgBox "IT Cost Estimate is missing from SA document!"
missingObject2 = True
Else
missingObject2 = False
End If


'If any objects are missing leave the application
If (missingObject1 Or missingObject2) Then
updateSuccess = False
GoTo Exit_Refresh_Click
End If


'1. Resources
wdDoc.Shapes("IT_ResourceEstimates").OLEFormat.Edit
Sheets("IT - Resources & Costs").Range("A5:G51").Copy
destXL.Sheets("IT - Resources & Costs").Activate
Range("A5:G51").Select
ActiveSheet.Paste


'2. Costs
wdDoc.Shapes("IT_CostEstimates").OLEFormat.Edit
Sheets("IT - Resources & Costs").Range("I4:O44").Copy
destXL.Sheets("IT - Resources & Costs").Activate
Range("I4:O44").Select
ActiveSheet.Paste
Range("A1").Select
xlApp.ScreenUpdating = True
destXL.Sheets("WaitMsg").Activate


updateSuccess = True


'Normal exit procedure:
'Close out the Word application and display complete message
'Problem seems to be sometime after this point...
Exit_Refresh_Click:
Set wdDoc = Nothing
wdApp.ActiveDocument.Close SaveChanges:=False


If wdRunning And fIsAppRunning("Word") Then
If updateSuccess Then
Sleep (20000)
End If
End If


xlApp.ScreenUpdating = True


wdApp.System.Cursor = wdCursorDefault
wdApp.ScreenUpdating = True


If wdRunning And fIsAppRunning("Word") Then
wdApp.Application.Quit
End If


Set wdApp = Nothing


destXL.Sheets("WaitMsg").Visible = xlSheetVeryHidden


Call SaveChanges
xlApp.Cursor = xlDefault
destXL.Sheets("TABLE OF CONTENTS").Activate
Set xlApp = Nothing


If updateSuccess Then
MsgBox "Update Completed!"
Else
MsgBox "Update Failed!"
End If


Set destXL = Nothing


Exit Sub


Bailout: 'Only if an extreme error has occurred ie Word crashing
Set wdDoc = Nothing
'wdApp.ScreenUpdating = True
Set wdApp = Nothing
destXL.Sheets("TABLE OF CONTENTS").Activate
xlApp.Cursor = xlDefault
xlApp.ScreenUpdating = True
Set xlApp = Nothing
Call SaveChanges
MsgBox "Update Failed!"


Exit Sub


Err_Refresh_Click:
Dim errorMsg As String
errorMsg = "An unexpected error has occurred." & vbCrLf & _
"Update failed with message: " & vbCrLf & _
Err.Description & "(Error No: " & Err.Number & ")"
MsgBox errorMsg
updateSuccess = False
Resume Bailout


End Sub


'Tests to see if embedded object is present in Word Document
Private Function DoesNotExist(ShapeName As String) As Boolean
On Error GoTo Err_Handler


Dim temp As String


temp = wdDoc.Shapes(ShapeName).Name
DoesNotExist = False


Exit_Handler:
Exit Function


Err_Handler:
DoesNotExist = True
Resume Exit_Handler


End Function
====End Code=====


As I mentioned, I am pretty new to vba and this stuff feels really
over my head, so any suggestions would be appreciated! Thanks in
advance.
Julia

 

[NickHK]

I didn't wade through all your code, but if this is in Excel VBA, you do not
need:

Set xlApp = GetObject(, "Excel.Application")

as you already have the Application object which refers to the current
instance.
Actually, the above code may return a completely different instance of Excel
to the one the code is running in, if multiple instances exist.

It would appear you are using late binding to Word, as you have decalred
those variables "As Object".
As such, you cannot use named constants/enums like "wdWindowStateMinimize",
but you need their numeric value, which can get from the Word VBE Immediate
window:
?wdWindowStateMinimize

What do expect this to evaluate to ?
If (missingObject1 Or missingObject2) Then

You could be more consistent with your references to objects instead of
mixing it up e.g.:
Sheets("IT - Resources & Costs").Range("A5:G51").Copy
destXL.Sheets("IT - Resources & Costs").Activate
Range("A5:G51").Select
ActiveSheet.Paste


NickHK

Hi,
I am somewhat new to vba and I am not sure if I am posting this in
the
right place but I can't seem to figure this one out or find a problem
that is similar in the postings.

My vba code runs in excel, which opens a word file, and then
subsequently has to access excel documents embedded in that word
file,
to copy some information back to the original excel document running
the code. After it is done, the code closes the document and then
word
(only if word was not previously running). The problem is that Word
seems to intermittently crash when I am trying to close the document
or the application.


I have thought of several reasons this may be happening. My primary
concern is this though: I do not know how change the focus/close from
the last embedded excel document once it has been activated, so I go
from that to just close the document. I wonder if what causes Word to
crash is that it is trying to hold on to the OLE connections of the
embedded excel files and takes time to release them. I had tried to
deal with this by putting a Sleep break in the program, but it still
seems to crash 1 out of about 10 times.


I have attached the code below:
========CODE============
Dim SAFileName As String
Dim strFilter As String


Dim wdApp As Object
Dim wdDoc As Object
Dim wdRunning As Boolean

--------- CUT ----