Option Compare Database

Option Explicit

Private Sub Command生成_Click()

On Error GoTo outputerror

'輸入文件名

Dim outputname As String

outputname = InputBox("請輸入導(dǎo)出的文件名", "生成文件", "準(zhǔn)考證：" & Me.準(zhǔn)考證號) '輸入要生成的表名-

If outputname = "" Or IsNull(outputname) Then? ?'為空則不執(zhí)行程序

Exit Sub

End If

'選擇導(dǎo)出的位置（文件夾）

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 & "\" & "準(zhǔn)考證模板.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:="學(xué)號"

? ? appword.Selection.typetext Text:=Me.學(xué)號

? ? 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:="準(zhǔn)考證號"

? ? appword.Selection.typetext Text:=Me.準(zhǔn)考證號

? ? 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