ACCESS-按WORD模板格式输出代码2

Private Sub WordOUT_DblClick(Cancel As Integer)

On Error GoTo outputerror

Dim outputname As String

outputname = InputBox("请输入导出的文件名", "生成文件", "人员：" & Me!出差职员.Value)

If outputname = "" Then Exit Sub

Dim exportpath As String

Dim dlgOpen As FileDialog

Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)

With dlgOpen

If .Show = -1 Then

exportpath = .SelectedItems(1)

Else

Exit Sub

End If

End With

Dim appword As New Word.Application

appword.Visible = True

Dim modelpathname As String

modelpathname = CurrentProject.Path & "\出差计划报告word模板.docx"

Dim newwordpathname As String

newwordpathname = exportpath & "\" & outputname & ".docx"

If Dir(newwordpathname) <> "" Then

MsgBox "该文档已存在"

GoTo 跳过文件创建

End If

Dim worddoc As Word.Document

Set worddoc = appword.Documents.Add(Template:=modelpathname, Visible:=True)

' 使用数组和循环来减少重复代码

Dim bookmarks() As Variant

Dim fields() As Variant

bookmarks = Array("出差日程", "出差职员", "出差地方", "出差目的", "计划1日期", "计划1内容", "计划2日期", "计划2内容", "预计费用")

fields = Array(Me!出差日程.Value, Me!出差职员.Value, Me!出差地方.Value, Me!出差目的.Value, _

Me!计划1日期.Value, Me!计划1内容.Value, Me!计划2日期.Value, Me!计划2内容.Value, Me!预计费用.Value)

Dim i As Integer

For i = LBound(bookmarks) To UBound(bookmarks)

appword.Selection.Goto What:=wdGoToBookmark, Name:=bookmarks(i)

appword.Selection.TypeText Text:=fields(i)

Next i

worddoc.SaveAs2 FileName:=newwordpathname, FileFormat:=wdFormatDocumentDefault

worddoc.Close

Set worddoc = Nothing

跳过文件创建:

appword.Quit

Set appword = Nothing

MsgBox "生成完成"

Exit Sub

outputerror:

MsgBox Err.Description

Exit Sub

End Sub