Hello

My Visual Basic application writes some text to a Word document.  It usually
works but on two computers on a site it crashes my application.

Anyone got any ideas on where to start looking.  Is removing Word, cleaning
up and re-installing the only option?

I am going on site to run the same VBA code from Excel to see if that works.
I can then check line for line what happens.

The basic code is here:

Private Sub cmdTestWord_Click()

Dim iSequence As Integer  'used to locate correct contact
Dim sDear As String       'Salutation on letter
Dim sTemp As String       'temp string to create address

Dim sLetter1 As String
Dim sLetter2 As String
Dim sLetter3 As String
Dim sSalute1 As String
Dim sSalute2 As String
Dim sSalute3 As String

Dim Title As String
Dim Firstname As String
Dim Initials As String
Dim Surname As String
Dim strPosition As String
Dim Familiar As String
Dim Ind As Integer
Dim ret As Long
Dim strToWord As String

'On Error GoTo WordErr
'Time bootup
'Dim dblSTime As Double
'dblSTime = Timer

'dblSTime = (Timer - dblSTime)
'MsgBox "Time taken: " & dblSTime
'Debug.Print "Time taken: " & dblSTime

Dim objWord As Word.Application
Dim objWordDoc As Word.Document  '''''''''''''''''****
Dim docspath As String

'Time loading of Word
'Dim dblSTime As Double
'dblSTime = Timer   '''''''''''''''''''''''''''

On Error Resume Next    'WordStart
LogError 0, "Just before Set objWord = GetObject(, Word.Application)",
"TestWord"
Set objWord = GetObject(, "Word.Application")
LogError 0, "After Set objWord = GetObject(, Word.Application)", "TestWord"
If Err.Number = 429 Then
   Set objWord = New Word.Application           '
CreateObject("Word.Application")
   LogError 0, "After Set objWord = New Word.Application", "TestWord"
End If
If objWord Is Nothing Then
   LogError Err.Number, "Unable to load Word object.  Word is Nothing",
"Letter in frmContacts"

   Exit Sub
End If

'' REMOVE THIS
objWord.Visible = True
LogError 0, "After objWord.Visible = True", "TestWord"
'On Error GoTo WordErr

Dim strLetter As String
strLetter = "letter.dot"

docspath = "C:\"

docspath = docspath & strLetter

If FileExists(docspath) = False Then
   MsgBox "File: " & docspath & " does not exist check your document
template path and check that the selected template document exists"

   Exit Sub
End If

   Title = "Mr"
   Firstname = "Angus"
   Initials = "R"
   Surname = "Comber"
   Familiar = "Angus"
   strPosition = "Director"

   'sDear stuff
   sDear = Familiar 'Dear

'Now need to address AddressLine
  strToWord = Firstname & " " & Surname

   strToWord = strToWord & VBA.Chr(13) & "5 Enmore Gardens"

   strToWord = strToWord & VBA.Chr(13) & "East Sheen"

   strToWord = strToWord & VBA.Chr(13) & "London, SW14 8RF"

   LogError Err.Number, "Just before Set objWordDoc =
objWord.Documents.Add(docspath, False)", "TestWord"

Set objWordDoc = objWord.Documents.Add(docspath, False)
' Sometime get a valid objWord object but problem creating document based on
template.
' So still need to check a valid objWordDoc created
If objWordDoc Is Nothing Then
   MsgBox "Unable to create Word Document object based on template: " &
docspath & " Unable to proceed with Word creation", vbCritical, "Word Error"
   LogError Err.Number, "Unable to create objWordDoc object.  'Set
objWordDoc = objWord.Documents.Add(docspath, Fales)'", "Letter in
frmContacts"
   objWord.Visible = True

   Exit Sub
End If

objWord.Application.ScreenUpdating = False
'objWord.Visible = True

Dim bRet As Boolean

'Find <Address> & replace with strToWord
'objWord.Selection.Find.Execute findtext:="<Address>",
replacewith:=strToWord  ', Replace:=wdReplaceAll
' Just in case named arguements can cause a problem - remove them!
'objWord.Selection.Find.Execute "<Address>", , , , , , , , , strToWord, True
'objWord.ActiveDocument.Range.WholeStory

'bRet = objWordDoc.Range.Find.Execute("<Address>", , , , , , , , ,
strToWord, Word.wdReplaceAll)
LogError 0, "Just before first LateBindingReplace objWordDoc, < Address >,
strToWord", "TestWord"
LateBindingReplace objWordDoc, "<Address>", strToWord

'Find <Dear> & replace with sDear
'objWord.Selection.WholeStory
'objWord.Selection.Find.Execute findtext:="<Dear>", replacewith:=sDear  ',
Replace:=wdReplaceAll
'objWord.Selection.Find.Execute "<Dear>", , , , , , , , , sDear, True
'objWordDoc.Range.Find.Execute "<Dear>", False, False, , , , , , , sDear,
True
LateBindingReplace objWordDoc, "<Dear>", sDear

LogError 0, "After last LateBindingReplace objWordDoc, < Dear >, strToWord",
"TestWord"

'objWordDoc.Range.Find.Execute
'Find <Start> & place cursor for user to start typing
'objWord.Selection.WholeStory
'objWord.Selection.Find.Execute findtext:="<Start>", replacewith:=""  ',
Replace:=wdReplaceAll

'objWordDoc.Range.WholeStory  ' select all text
'objWordDoc.Range.Find.Execute "<Address>", False, False, False, False,
False, True, Word.wdFindContinue, False, "Abba", Word.wdReplaceAll
'If Err.Number <> 0 Then
'    LateBindingReplace objWordDoc, "<Address>", strToWord
'End If
'objWordDoc.Range.Find.text = "<Address>"
'objWordDoc.Range.Find.Replacement.text = "Abba"

'objWordDoc.Range.Find.Execute
LogError 0, "Just before objWord.ActiveDocument.Variables(SiteID).Value =",
"TestWord"

   objWord.ActiveDocument.Variables("SiteID").Value = 3
   objWord.ActiveDocument.Variables("HType").Value = "Letter"
   objWord.ActiveDocument.Variables("HComputer").Value = "MyComputername"

LogError 0, "After last objWord.ActiveDocument.Variables(HComputer).Value
=", "TestWord"

LogError 0, "Just before objWord.Application.ScreenUpdating = True",
"TestWord"
objWord.Application.ScreenUpdating = True
LogError 0, "Just after objWord.Application.ScreenUpdating = True",
"TestWord"
objWord.Visible = True
LogError 0, "Just after objWord.Visible = True", "TestWord"
objWord.Application.WindowState = Word.wdWindowStateMaximize
LogError 0, "Just after objWord.Application.WindowState = ", "TestWord"

LogError 0, "Just before bjWord.Application.Activate", "TestWord"
objWord.Application.Activate
LogError 0, "Just after bjWord.Application.Activate", "TestWord"

'dblSTime = (Timer - dblSTime)
'MsgBox "Time taken: " & dblSTime

End Sub

Public Sub LogError(ByVal errnum As Integer, ByVal ErrDescription As String,
Optional ByVal ProcName As String)
On Error Resume Next
   Dim msg As String
   Dim iFilenum As Integer  'To get a free filenumber
   msg = Date & vbTab & Time & vbTab & ProcName & vbTab & errnum & vbTab &
ErrDescription
   iFilenum = FreeFile
   Open "C:\Errors.log" For Append As #iFilenum
   'Write new value
   Print #iFilenum, msg
   Close #iFilenum
'    MsgBox msg
'Debug.Print msg
End Sub

' Due to http://support.microsoft.com/default.aspx?scid=kb;EN-US;292744
' which is a COM problem with Word's Find object clashing with an old
version of Excel
' sometimes Find method will NOT work.  So have to use Late binding to
accomplish
' Find replace.  Requires a Word Document object plus search and replace
strings
Public Function LateBindingReplace(oWordDoc As Word.Document, strFind,
strReplace) As Long
On Error Resume Next
Dim oFind As Object   ' Word.Find
'MsgBox "we are in latebindingreplace now!"
Set oFind = oWordDoc.Content.Find

If oFind Is Nothing Then
   LogError Err.Number, "Unable to create oFind object. '",
"LateBindingReplace in modMisc"
   LateBindingReplace = -1
   Exit Function
End If
oFind.Execute strFind, False, False, False, _
   False, False, True, Word.wdFindContinue, False, strReplace, _
   Word.wdReplaceAll

LateBindingReplace = Err.Number

End Function

Private Function FileExists(strFile As String) As Boolean
   Dim MyFile As String
   ' Returns filename if it exists.
   MyFile = Dir(strFile)

   If MyFile <> "" Then
       FileExists = True
   Else
       FileExists = False
   End If
End Function