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