Private Sub 导出word_Click()
On Error GoTo ErrorHandler
Dim strTemplate As String
Dim strFileName As String
Dim objApp As Object 'New Word.Application
Dim objDoc As Object 'Word.Document
Dim objField As Object 'Word.Field
Dim rst As Object
Dim blnNoQuit As Boolean
strTemplate = CurrentProject.Path & "\文件模板\聘用协议模板.doc"
'设置鼠标指针为沙漏形状
DoCmd.Hourglass True
Set objApp = CreateObject("Word.Application")
Set objDoc = objApp.Documents.Open(strTemplate)
Set rst = CurrentDb.OpenRecordset("SELECT * FROM 待入职员工 WHERE ID=" & ID, , 4) 'dbReadOnly
If Not rst.EOF Then
strFileName = CurrentProject.Path & "\存放位置\" & "聘用协议" & rst!ID & ".doc"
'如果文件已存在,先删除已有文件
If Dir(strFileName) <> "" Then Kill strFileName
objDoc.FormFields("姓名").result = rst!姓名
objDoc.FormFields("签约单位").result = rst!签约单位
objDoc.FormFields("签约部门").result = rst!签约部门
objDoc.FormFields("签约岗位").result = rst!签约岗位
objDoc.FormFields("工时标准").result = rst!工时标准
objDoc.FormFields("工时地点").result = rst!工时地点
objDoc.FormFields("聘用协议截止日期").result = rst!聘用协议截止日期
objDoc.FormFields("合同开始日期").result = rst!合同开始日期
objDoc.FormFields("聘用协议发送日期").result = rst!聘用协议发送日期
End If
rst.Close
objDoc.SaveAs strFileName
Beep
If MsgBox("导出已完成,是否打开该文件?", vbQuestion + vbYesNo, "导出完成") = vbYes Then
objApp.Visible = True
objDoc.Saved = True
blnNoQuit = True
End If
ExitHere:
On Error Resume Next
If Not blnNoQuit Then
If Not objDoc Is Nothing Then objDoc.Saved = True
If Not objApp Is Nothing Then objApp.Quit
End If
'恢复鼠标指针
DoCmd.Hourglass False
'释放对象变量内存
Set objApp = Nothing
Set objDoc = Nothing
Set rst = Nothing
Exit Sub
ErrorHandler: '错误处理程序
If Err = 70 Then
MsgBox "不能替换文件,因为无法删除已有文件,可能的原因有:" & vbCrLf & vbCrLf & _
"1.该文件处于打开状态。" & vbCrLf & _
"2.没有对此目录的写入权限。", vbCritical
Else
MsgBox Err.Description, vbCritical, "出错 #" & Err
End If
Resume ExitHere
End Sub
这个提示 语法错误(操作符丢失)在查询表达式中'id='中。为什么呢