Solved: Saving Word Document via VBA in Access 2003

[JustJerry]

Hello everyone,

I have the following code that works flawlessly when running Access 2003 and Word 2003:

Private Sub RunWordTemplate_Click()
On Error GoTo Err_RunWordTemplate_Click
Dim intAnswerMe As Integer

'Fill in Work Order Description if blank to avoid Null error in Word
If IsNull(Me.WODesc.Value) Or _
Me.WODesc = 0 Then
intAnswerMe = MsgBox("Please enter in a Work Order Description", vbOKOnly + vbInformation, "Description Needed")
Me.WODesc.SetFocus
Exit Sub
End If

Dim oApp As Object 'Variable for Word
Dim sFilename As String 'Variable for Auto-Save file name
Dim strTemplateName As String 'Variable for Word Template to be used
Dim objWORDdoc As Object

'Save Record
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

'Create path to Quotation Template
strTemplateName = "\\Sharppc\ServerFiles\ProjectData\Quotations\QuotationTemp.dot (file://\\Sharppc\ServerFiles\ProjectData\Quotations\QuotationTemp.dot)"
'Create default SaveName for New Quotation being written
sFilename = "\\Sharppc\ServerFiles\ProjectData\Quotations\ (file://\\Sharppc\ServerFiles\ProjectData\Quotations\)" & Me.WONum.Value & " - " & Me.CompanyName.Value & ".doc"

Set oApp = CreateObject("Word.Application")
oApp.Visible = True

If Dir(sFilename) = "" Then 'Test to see if created filename already exists
'and if not, open Template to fill in date
Set oApp = CreateObject("word.basic") 'otherwise just open that filename already
With oApp

.filenew Template:=strTemplateName
'Set bookmarks in QuotationTemp to equal values of new Quoation Number created
.EditBookmark Name:="quotedate", GoTo:=True
.Insert (Format(Me.WODate, "mmmm dd, yyyy")) 'insert date of quote
.EditBookmark Name:="quotenum", GoTo:=True
.Insert (CStr(Me.WONum)) 'insert work order number
.EditBookmark Name:="companyname", GoTo:=True
.Insert (CStr(Me.CompanyName)) 'insert company name

'This code will make sure that if the street address has two lines, both are inserted
If IsNull(DLookup("[CustAdd2]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'")) Or _
DLookup("[CustAdd2]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'") = 0 Then
.EditBookmark Name:="address", GoTo:=True 'insert Line 1 address
.Insert ((CStr(DLookup("[CustAdd1]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'"))))
Else
.EditBookmark Name:="address", GoTo:=True 'insert Line 1 & 2 address
.Insert (CStr(DLookup("[CustAdd1]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'"))) & vbCrLf & (CStr(DLookup("[CustAdd2]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'")))
End If

.EditBookmark Name:="citystate", GoTo:=True
.Insert ((CStr(DLookup("[CustCity]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'"))) & ", " & (CStr(DLookup("[StateID]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'"))) & " " & (CStr(DLookup("[CustZip]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'"))))
.EditBookmark Name:="custname", GoTo:=True
.Insert (CStr(Me.Contact))
.EditBookmark Name:="subject", GoTo:=True
.Insert (CStr(Me.WODesc))
.EditBookmark Name:="firstname", GoTo:=True
.Insert (CStr(DLookup("[fName]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'")) & ",")

.filesaveas Name:=sFilename 'save Quotation with auto save name

End With

Else 'If filename already exists, just open the file at this point

oApp.Documents.Open sFilename
oApp.ActiveDocument.Save

End If
Exit_RunWordTemplate_Click:
Exit Sub
Err_RunWordTemplate_Click:
MsgBox Err.Description
Resume Exit_RunWordTemplate_Click


My problem comes from two users that have Access 2003 and Word 2007. Apparently there is an issue that arrises when this code is ran and the file is saved under Word 2007, the file can only be looked at using 2007 - even though it has the .doc extention and not the .docx extention. When the Word 2003 users try to access the file, they get an error asking to select the encoding to make the document readable.

I 'think' the issue comes from this line of the code:

.filesaveas Name:=sFilename 'save Quotation with auto save name


I know in Word 2007 you have to select the SaveAs 97-2003 version for the .doc filename.

My questions are these:

1) Is there some code that I would need to run to check the version of word running and have one save line for the 2003 users, and one save for the 2007 users?

2) Is there some option I am missing under the .filesaveas Name:=sFileName that would solve this issue?

Also, when the 2003 user runs this code, either user can read the file without issue.

Thank you for any help

[JustJerry]

Ok, I tried this to no avail:
If oApp.Version = 12 Then
.filesaveas Name:=sFilename, FileFormat:=1
Else
.filesaveas Name:=sFilename 'save Quotation with auto save name
End If

Am I on the right track? WHen it tries to save the file in Word2007, it says the Object does not support this property or method, so I am clueless on the FileFormat:=1 option, or if I am way off base.

Also, FileFormat:=wdFormatDocument97 does not work either

[JustJerry]

Someone suggested that this line of code:
Set oApp = CreateObject("word.basic")
Might be causing me a problem. Not sure what to change this to since
we are using both 2003/2007 versions of word in the office. Any suggestions?

[CreganTur]

I'm not very familiar with Office 2007... but I'm thinking the problem probably has something to do with the fact that you're writing a Word Basic document, not a Word document.

You're using the CreateObject method to work with a Word Basic document, but if you were working with Word, you would not be using the CreateObject method at all.

I've rewritten your code using the Word.Application method. It should work with both 2003 and 2007 versions of Word... but I cannot test it, since I haven't got 2007 here at work.

You will have to set a reference (tools -> reference) to the Microsoft Office Word xx.0 Object Library (where xx.0 is whatever version number you have)

Try this (appologies for the wide code window- I didn't want to risk messing up the op's code by using underscores, since I can't test it):
Private Sub RunWordTemplate_Click()
On Error GoTo Err_RunWordTemplate_Click
Dim intAnswerMe As Integer

'Fill in Work Order Description if blank to avoid Null error in Word
If IsNull(Me.WODesc.Value) Or _
Me.WODesc = 0 Then
intAnswerMe = MsgBox("Please enter in a Work Order Description", vbOKOnly + vbInformation, "Description Needed")
Me.WODesc.SetFocus
Exit Sub
End If

Dim oApp As Word.Application 'Variable for Word
Dim sFilename As String 'Variable for Auto-Save file name
Dim strTemplateName As String 'Variable for Word Template to be used
Dim objWORDdoc As Word.Document

'Save Record
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

'Create path to Quotation Template
strTemplateName = "\\Sharppc\ServerFiles\ProjectData\Quotations\QuotationTemp.dot (file://\\Sharppc\ServerFiles\ProjectData\Quotations\QuotationTemp.dot)"
'Create default SaveName for New Quotation being written
sFilename = "\\Sharppc\ServerFiles\ProjectData\Quotations\ (file://\\Sharppc\ServerFiles\ProjectData\Quotations\)" & Me.WONum.Value & " - " & Me.CompanyName.Value & ".doc"

Set oApp = New Word.Application
oApp.Visible = True

If Dir(sFilename) = "" Then 'Test to see if created filename already exists
'and if not, open Template to fill in date
Set objWORDdoc = oApp.Documents.Open(strTemplateName)

objWORDdoc.Bookmarks("quotedate").Range.Text = (Format(Me.WODate, "mmmm dd, yyyy")) 'insert date of quote
objWORDdoc.Bookmarks("quotenum").Range.Text = (CStr(Me.WONum)) 'insert work order number
objWORDdoc.Bookmarks("companyname").Range.Text = (CStr(Me.CompanyName)) 'insert company name

'This code will make sure that if the street address has two lines, both are inserted
If IsNull(DLookup("[CustAdd2]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'")) Or DLookup("[CustAdd2]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'") = 0 Then
objWORDdoc.Bookmarks("address").Range.Text = ((CStr(DLookup("[CustAdd1]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'"))))
Else
objWORDdoc.Bookmarks("address").Range.Text = (CStr(DLookup _
("[CustAdd1]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'"))) & vbCrLf & (CStr(DLookup("[CustAdd2]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'")))
End If

objWORDdoc.Bookmarks("citystate").Range.Text = ((CStr(DLookup("[CustCity]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'"))) & ", " & (CStr(DLookup("[StateID]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'"))) & " " & (CStr(DLookup("[CustZip]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'"))))
objWORDdoc.Bookmarks("custname").Range.Text = (CStr(Me.Contact))
objWORDdoc.Bookmarks("subject").Range.Text = (CStr(Me.WODesc))
objWORDdoc.Bookmarks("firstname").Range.Text = (CStr(DLookup("[fName]", "ContactsTbl", "[Contact]='" & Me.Contact.Value & "'")) & ",")

objWORDdoc.SaveAs sFilename 'save Quotation with auto save name

Else 'If filename already exists, just open the file at this point

oApp.Documents.Open sFilename
oApp.ActiveDocument.Save

End If
Exit_RunWordTemplate_Click:
Exit Sub
Err_RunWordTemplate_Click:
MsgBox Err.Description
Resume Exit_RunWordTemplate_Click
End Sub

[JustJerry]

First of all, thank you for helping. Didn't expect you to rewrite anything :hi:

I am working on my laptop which has 2007, and I this error:

"User Defined Type not Defined" on this line
Dim oApp As Word.Application 'Variable for Word

[CreganTur]

I am working on my laptop which has 2007, and I this error:

"User Defined Type not Defined" on this line

Did you set the reference (Tools -> References [in the VBE]) to the Microsoft Word xx.0 Object Library? (where xx.0 is whatever version number you have)?

[JustJerry]

Cregan, I can't thank you enough. It is now working for all users now!!

Thank you, Thank you, Thank you