Run time Error 5151 creating word doc in Access Application using vba

[WHerman]

I am trying to fix some old Code written by someone else. Environment is MS Access 2007 and Office 2007 on windows 7 pc. The flow is values are keyed in on a form and then the button to create a letter is clicked. Error occurs at point in code indicated below. Have tried hardcoding patchs to local C drive without success. No file has been created. The error is as follows Word was unable to read this document. It may be corrupt. Try one or more of the following: * open and repair the file. * Open the file with the Test Recovery converter. Suggestions on trouble shooting the problem will be appreciated.

Private Sub cmdCreateLetter_Click()

DoCmd.SetWarnings False
DoCmd.OpenQuery "qryLetterQuoteDetails"

'open the quote template and insert data
Dim appWord As Word.Application
Dim docWord As Word.Document
Dim db As Database
Dim rstQuoteDetails As DAO.Recordset
Dim strSender As String
Dim strRE As String
Dim strFileName As String
Dim strTitle As String

strFileName = Me.txtQuoteNumber
Set db = CurrentDb()
Set rstQuoteDetails = db.OpenRecordset("tblquotestempquotedetails")

      

'Verify all required fields are completed
If IsNull(txtQuoteEnteredBy) Then
    MsgBox "Please enter name of employee entering the quote information."
    txtQuoteEnteredBy.SetFocus
    Exit Sub
End If
If IsNull(txtQuoteCompletedBy) Then
    MsgBox "Please enter name of employee completing the quote information."
    txtQuoteCompletedBy.SetFocus
    Exit Sub
End If
If IsNull(txtNewCustomerID) And IsNull(txtCurrentCustomerID) Then
    MsgBox "Please select one company to receive this quote"
    txtNewCustomerID.SetFocus
    Exit Sub
End If
If Not IsNull(txtNewCustomerID) And Not IsNull(txtCurrentCustomerID) Then
    MsgBox "Please select only one company to receive this quote"
    txtNewCustomerID.SetFocus
    Exit Sub
End If
If IsNull(txtSurname) Then
    MsgBox "Please select the surname of the person receiving this quote."
    txtSurname.SetFocus
    Exit Sub
End If
If IsNull(txtFirstName) Then
    MsgBox "Please enter the first name of the person receiving this quote."
    txtFirstName.SetFocus
    Exit Sub
End If
If IsNull(txtLastName) Then
    MsgBox "Please enter the last name of the person receiving this quote."
    txtLastName.SetFocus
    Exit Sub
End If

'If recordset is empty, post message, exit sub
If rstQuoteDetails.RecordCount = 0 Then
    MsgBox "There are no records to quote"
    Exit Sub
End If
'End of verification of required fields

'Assign values to variables
strSender = DLookup("FirstName", "tblEmployee", "[employeeid] =" _
    & Forms!frmQuotes!txtQuoteCompletedBy) & " " & _
            DLookup("LastName", "tblEmployee", "[employeeid] =" _
    & Forms!frmQuotes!txtQuoteCompletedBy)
'Assign strTitle
    If IsNull(DLookup("Title", "tblEmployee", "[employeeid] =" _
        & Forms!frmQuotes!txtQuoteCompletedBy)) Then
        strTitle = ""
    Else
        strTitle = DLookup("Title", "tblEmployee", "[employeeid] =" _
        & Forms!frmQuotes!txtQuoteCompletedBy)
    End If

strRE = "Quote " & Forms!frmQuotes!txtQuoteNumber
    
    
'Open Word and template
Set appWord = New Word.Application
Set docWord = appWord.Documents.Add("g:\HazQuote.dot")             <-----------  Runtime error 5151 occurs here ------------
With appWord
    .ActiveDocument.ShowSpellingErrors = False
    .ActiveDocument.ShowGrammaticalErrors = False
End With

'Insert address and contact data at the proper bookmark
'The first part is for current customers
If IsNull(txtNewCustomerID) And Not IsNull(txtCurrentCustomerID) Then
    With appWord
    .Selection.GoTo wdGoToBookmark, Name:="Date"
    appWord.Selection.TypeText Format(txtDate, "mmmm d, yyyy")
    
    .Selection.GoTo wdGoToBookmark, Name:="Company"
    appWord.Selection.TypeText DLookup("CompanyName", "tblcustomer", _
        "[CustomerID]=" & [Forms]![frmQuotes]![txtCurrentCustomerID])
        
    .Selection.GoTo wdGoToBookmark, Name:="Contact"
    appWord.Selection.TypeText txtSurname & " " & [Forms]![frmQuotes]![txtFirstName] _
        & " " & [Forms]![frmQuotes]![txtLastName]
        
    .Selection.GoTo wdGoToBookmark, Name:="Address"
    appWord.Selection.TypeText DLookup("MailAddress1", "tblcustomer", _
        "[CustomerID]=" & [Forms]![frmQuotes]![txtCurrentCustomerID])
        
    .Selection.GoTo wdGoToBookmark, Name:="CityStateZip"
    appWord.Selection.TypeText _
    DLookup("MailCity", "tblcustomer", "[CustomerID]=" & _
        [Forms]![frmQuotes]![CurrentCustomerID]) & ", " & _
    DLookup("MailState", "tblcustomer", "[CustomerID]=" & _
        [Forms]![frmQuotes]![CurrentCustomerID]) & "  " & _
    DLookup("MailPostalCode", "tblcustomer", "[CustomerID]=" & _
        [Forms]![frmQuotes]![txtCurrentCustomerID])
        
    .Selection.GoTo wdGoToBookmark, Name:="RE"
    appWord.Selection.TypeText strRE
    
    .Selection.GoTo wdGoToBookmark, Name:="Contact2"
    appWord.Selection.TypeText txtSurname & " " & [Forms]![frmQuotes]![txtLastName]
    End With

'This part is for new customers
ElseIf Not IsNull(txtNewCustomerID) And IsNull(txtCurrentCustomerID) Then
    With appWord
        .Selection.GoTo wdGoToBookmark, Name:="Date"
        appWord.Selection.TypeText Format(txtDate, "mmmm d, yyyy")
        
        .Selection.GoTo wdGoToBookmark, Name:="Company"
        appWord.Selection.TypeText DLookup("CompanyName", "tblNewCustomer", _
            "[CustomerID]=" & [Forms]![frmQuotes]![txtNewCustomerID])
            
        .Selection.GoTo wdGoToBookmark, Name:="Contact"
        appWord.Selection.TypeText txtSurname & " " & [Forms]![frmQuotes]![txtFirstName] _
            & " " & [Forms]![frmQuotes]![txtLastName]
            
        .Selection.GoTo wdGoToBookmark, Name:="Address"
        appWord.Selection.TypeText DLookup("MailAddress1", "tblNewCustomer", _
            "[CustomerID]=" & [Forms]![frmQuotes]![txtNewCustomerID])
            
        .Selection.GoTo wdGoToBookmark, Name:="CityStateZip"
        appWord.Selection.TypeText _
        DLookup("MailCity", "tblNewCustomer", "[CustomerID]=" & _
            [Forms]![frmQuotes]![txtNewCustomerID]) & ", " & _
        DLookup("MailState", "tblNewCustomer", "[CustomerID]=" & _
            [Forms]![frmQuotes]![txtNewCustomerID]) & "  " & _
        DLookup("MailPostalCode", "tblNewCustomer", "[CustomerID]=" & _
            [Forms]![frmQuotes]![txtNewCustomerID])
            
        .Selection.GoTo wdGoToBookmark, Name:="RE"
        appWord.Selection.TypeText strRE
        
        .Selection.GoTo wdGoToBookmark, Name:="Contact2"
        appWord.Selection.TypeText txtSurname & " " & [Forms]![frmQuotes]![txtLastName]
    End With
End If
    
'Insert details data in the proper table field

Dim strDetails As String
Dim strPrice As String
Dim strUnit As String
Dim intCount As Integer

intCount = 0


Do
intCount = intCount + 1
strDetails = "Details" & intCount
strPrice = "Price" & intCount
strUnit = "Unit" & intCount

With appWord
    .Selection.GoTo wdGoToBookmark, Name:=strDetails
    appWord.Selection.TypeText rstQuoteDetails!MaterialServices
    .Selection.GoTo wdGoToBookmark, Name:=strPrice
    appWord.Selection.TypeText rstQuoteDetails!Price1
    .Selection.GoTo wdGoToBookmark, Name:=strUnit
    appWord.Selection.TypeText rstQuoteDetails!UOMContainerSize
   
    
    rstQuoteDetails.MoveNext
End With
Loop While rstQuoteDetails.EOF = False

With appWord
    .Selection.GoTo wdGoToBookmark, Name:="Sender"
    appWord.Selection.TypeText strSender
    .Selection.GoTo wdGoToBookmark, Name:="Title"
    appWord.Selection.TypeText strTitle
    
    .Selection.GoTo wdGoToBookmark, Name:="Description"
End With

'checks to see if the file exists. if does not exist a copy is saved,
'if a copy exists it does not save the file
    
Dim strPath As String
Dim strFile As String
Dim strTest As String

strPath = "\\appserver\common\Quotes\Haz-Quotes\"
'strPath = CurrentDBDir() '  "G:\"
strFile = Me.txtQuoteNumber & ".doc"
strFile2 = Me.txtQuoteNumber & ".docx"
'MsgBox strFile
'MsgBox strFile2

'With Application.FileSearch
    '.NewSearch
    '.LookIn = strPath
    '.FileName = strFilename
strTest = Dir(strPath & strFile, vbNormal)
strTest2 = Dir(strPath & strFile2, vbNormal)
'MsgBox strTest
'MsgBox strTest2
    If strTest <> "" Or strTest2 <> "" Then
        If MsgBox("A previous copy of this file exists," & Chr(13) _
        & "Do you want to overwrite", vbYesNo, "File exists ... Overwrite?") = vbYes Then
            appWord.ActiveDocument.SaveAs strPath & strFile
            MsgBox "File Saved"
        Else
            Exit Sub
        End If
    Else
        appWord.ActiveDocument.SaveAs strPath & strFile
        MsgBox "File Saved"
    End If
'End With

appWord.Visible = True

End Sub

[ItsMe]

You have a file hardcoded to be opened.
Set docWord = appWord.Documents.Add("g:\HazQuote.dot")

The first thing that jumps out is the likelihood of a mapped drive. Then you mentioned the cold is old and written by someone else. So, do you have access to that file via the mapped drive G?

EDIT: I just noticed the extension. What is DOT? Sounds like something new

[ssanfu]

@ItsMe -

it is the extension for a Word template file. You open it, enter whatever and it forces you to save it with a different name (forced SaveAs).
Word 2000 and earlier extension.

I think Word 2007 and later the extension is .DOTX or .DOTM (with macros)

[ItsMe]

Haha, I see it now. Well, it was new for a few minutes.

[WHerman]

Hello thanks for your quick reply. I was testing using a profile I know has access to the mapped drive. I restored the the HazQuote.dot from a backup and the application appears to be working now. Not sure what the problem was with the old .dot file. This should solve the issue.

[ItsMe]

Thanks for the update. Perhaps a connection was lost that had the word file open, err sumthin.