Access2007 generating Word doc -Vista

[Rosemary]

I have a database that generates a Word document from a template. There
haven't been problems until we got Vista a couple weeks ago. Now, it
generates the document, but it is always corrupt. Looks like it's XML being
save as a docx file.
Attached is the VB code being used, sorry for the length, I tried to shrink
it some.

Private Sub cmdGenerateCertificate_Click()

Dim sAwardee
Dim sCitation
Dim sDateAwarded
Dim sSigAuthorityName
Dim sSigAuthorityTitle1
Dim sSigAuthorityTitle2
Dim sSigAuthorityTitle3
Dim sIssuingAuthority
Dim iIdentifier
Dim fso
Dim txtDocName
Dim Doc
Dim Success
Dim sPath
Dim strRptName As String
Dim strSQLWhere As String

On Error GoTo GenerateError

'DoCmd.Hourglass (True)

sAwardee = UCase(Me.Awardee.Value)
sCitation = Me.Citation.Value
Me.DateAwarded.SetFocus
sDateAwarded = Me.DateAwarded.Text
sSigAuthorityName = Me.cboSignatureAuthority.Column(1)
sSigAuthorityTitle1 = Me.cboSignatureAuthority.Column(2)
sSigAuthorityTitle2 = Me.cboSignatureAuthority.Column(3)
sSigAuthorityTitle3 = Me.cboSignatureAuthority.Column(4)
sIssuingAuthority = Me.cboIssuingAuthority.Column(1)
sawardtype = Me.AwardType.Value

If IsNull(sawardtype) Then
' DoCmd.Hourglass (False)
MsgBox "Please select an award type to generate."
Exit Sub
Else
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
End If

sAwardTypeTemplate = sawardtype
iIdentifier = Me.ID.Value
strSQLWhere = "AwardCertificates.ID = " & iIdentifier


Select Case sawardtype

Case "Recognition of 5 Years"
strRptName = "5 Year"
DoCmd.OpenReport strRptName, acPreview, , strSQLWhere
Case "Recognition of 10 Years"
strRptName = "10 Year"
DoCmd.OpenReport strRptName, acPreview, , strSQLWhere
Case "Recognition of 15 Years"
strRptName = "15 Year"
DoCmd.OpenReport strRptName, acPreview, , strSQLWhere
Case "Recognition of 20 Years"
strRptName = "20 Year"
DoCmd.OpenReport strRptName, acPreview, , strSQLWhere
Case "Recognition of 25 Years"
strRptName = "25 Year"
DoCmd.OpenReport strRptName, acPreview, , strSQLWhere
Case "Recognition of 30 Years"
strRptName = "30 Year"
DoCmd.OpenReport strRptName, acPreview, , strSQLWhere
Case "Recognition of 35 Years"
strRptName = "35 Year"
DoCmd.OpenReport strRptName, acPreview, , strSQLWhere
Case "Recognition of 40 Years"
strRptName = "40 Year"
DoCmd.OpenReport strRptName, acPreview, , strSQLWhere
Case "Recognition of 45 Years"
strRptName = "45 Year"
DoCmd.OpenReport strRptName, acPreview, , strSQLWhere
Case Else
'Delete the document if it exists
Set fso = CreateObject("Scripting.FileSystemObject")

txtDocName = Application.CurrentProject.Path & "\Certificates\" &
sAwardee & "_" & sDateAwarded & "_" & sawardtype & "_" & iIdentifier &
"_Certificate.docx"
If (fso.FileExists(txtDocName)) Then
fso.DeleteFile (txtDocName)
End If

' Set the variable (runs new instance of Word.)
Set Doc = CreateObject("Word.Application")
Doc.Documents.Open Application.CurrentProject.Path & "\Templates\" &
sAwardTypeTemplate & "_Certificate.dotm"

On Error Resume Next
'Set Awardee
If Not IsNull(sAwardee) Then
Set wrdRange = Doc.ActiveDocument.Bookmarks("Awardee").Range
wrdRange.InsertBefore (sAwardee)
Set wrdRange = Nothing
End If
(Cut out some of these so it wouldn't be so long)
'Set Issuing Authority
If Not IsNull(sIssuingAuthority) Then
Set wrdRange =
Doc.ActiveDocument.Bookmarks("IssuingAuthority").Range
wrdRange.InsertBefore (sIssuingAuthority)
Set wrdRange = Nothing
End If

'On Error GoTo 0
Doc.NormalTemplate.Saved = True

'Save the document
Doc.ActiveDocument.AcceptAllRevisions
' Doc.ActiveDocument.Save txtDocName
Doc.ActiveDocument.saveas FileName:=txtDocName,
FileFormat:=wdFormatDocument

Doc.Quit
Set Doc = Nothing

'Clean Up
Set fso = Nothing

For x = 1 To 20000
DoEvents
Next

'Open the document
'sPath = RetrieveWordPath()
sPath = "C:\Program Files\Microsoft Office\Office12\WINWORD.EXE "
'sPath = Chr(34) & Left(sPath, Len(sPath) - 11) & Chr(34) & " "
Success = Shell(sPath & Chr(34) & txtDocName & Chr(34),
vbMaximizedFocus)
End Select
Exit Sub

GenerateError:
DoCmd.Hourglass (False)
MsgBox Err.Number & ": " & Err.Description

End Sub