ExcelBanter - Excel VBA cause Word to Crash

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.Edi t
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 procedu
'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