根据模板生成word文档并填充数据 Access数据库系统功能模块讲解 VBA代码实例

Option Compare Database

Option Explicit

Private Sub Command生成_Click()

On Error GoTo outputerror

‘输入文件名

Dim outputname As String

outputname = InputBox(“请输入导出的文件名”, “生成文件”, “准考证:” & Me.准考证号) ‘输入要生成的表名-

If outputname = “” Or IsNull(outputname) Then   ‘为空则不执行程序

Exit Sub

End If

‘选择导出的位置(文件夹)

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

Dim worddoc As Object

appword.Visible = True

Dim modelpathname As String

modelpathname = CurrentProject.Path & “\” & “准考证模板.dotx”    ‘模板文件

Dim newwordpathname As String

    newwordpathname = exportpath & “\” & outputname & “.docx”

    If IsFileExists(newwordpathname) = True Then

    MsgBox “该文档已存在”

    GoTo 存在则跳过

    End If

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

    appword.Selection.Goto what:=wdGoToBookmark, Name:=”学号”

    appword.Selection.typetext Text:=Me.学号

    appword.Selection.Goto what:=wdGoToBookmark, Name:=”姓名”

    appword.Selection.typetext Text:=Me.姓名

    appword.Selection.Goto what:=wdGoToBookmark, Name:=”性别”

    appword.Selection.typetext Text:=Me.性别

    appword.Selection.Goto what:=wdGoToBookmark, Name:=”班级”

    appword.Selection.typetext Text:=Me.班级

    appword.Selection.Goto what:=wdGoToBookmark, Name:=”考场”

    appword.Selection.typetext Text:=Me.考场

    appword.Selection.Goto what:=wdGoToBookmark, Name:=”准考证号”

    appword.Selection.typetext Text:=Me.准考证号

    worddoc.SaveAs newwordpathname, wdformatdocumentdefault     ‘ & “.docx”

    worddoc.Close

    Set worddoc = Nothing

存在则跳过:

appword.Quit

Set appword = Nothing

MsgBox “生成完成”

‘——————————————

Exit Sub

outputerror:

MsgBox Err.Description

End Sub

Function IsFileExists(ByVal strFileName As String) As Boolean   ‘判断文件是否存在

  If Len(Dir(strFileName)) <> 0 Then

    IsFileExists = True

  Else

    IsFileExists = False

  End If

End Function

资源下载: