这里的数据库采用的是ACCESS生成的MDB数据库。考虑到在VB中画表等操作比较繁琐,所以采用了饮用模版的导出形式。仅供大家学习参考。
Dim cn As New ADODB.Connection ‘定义数据库 Dim rs As New ADODB.Recordset Dim scan As String ‘存储查找数据库 Dim Appword As Word.Application ’定义WORD模型变量 Dim Newword As Word.Document Set Appword = New Word.Application Set Newword = Appword.Documents.Add(App.Path + "/stencil" + "/stencil.doc") ‘这里是打开模版文档。stencil是模板的意思。可根据自己的需要替换。 Appword.Visible = False ‘隐藏WORD。导出时不在任务栏出现WORD文档。 Appword.WindowState = wdWindowStateMinimize scan = text2(0).Text '按编号搜索需要导出word的记录,一次只能导出一条记录 rs.CursorLocation = adUseClient ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "/data.mdb;Jet OLEDB:Database Password=harry2000" cn.Open ConnectionString rs.Open "select * from ADMIN where 编号 = '" & scan & "'",cn,adOpenKeyset,adLockOptimistic‘查找需要导出的记录 If rs.RecordCount = 0 Then ’如果不存在该记录 MsgBox "请在左边选择需要导出的记录" Appword.Documents.Close Appword.Quit Exit Sub Else ‘如果存在记录则运行以下代码 With Newword ’设置模版表格和在表格中填入数据库内容。 .Tables(1).Cell(1,1).Range.Text = (Format(rs!日期,"yyyy年mm月dd日")) .Tables(1).Cell(1,3).Range.Text = "第" & rs!次数 & "次到访" .Tables(2).Cell(1,2).Range.Text = (rs!姓名) .Tables(2).Cell(1,4).Range.Text = (rs!性别) .Tables(2).Cell(1,6).Range.Text = (rs!年龄) .Tables(2).Cell(2,2).Range.Text = (rs!所在单位 & rs!所在职位) .Tables(2).Cell(2,4).Range.Text = (rs!联系电话) .Tables(2).Cell(3,2).Range.Text = (rs!领导) .Tables(2).Cell(3,4).Range.Text = (rs!时间) '可以根据自己的需要设置填写内容。 End With Appword.ChangeFileOpenDirectory (App.path+ "/导出WORD文件夹") Appword.ActiveDocument.SaveAs FileName:=(App.path+ "/导出WORD文件夹/" & rs!姓名 & Format(Now,"yyyy-mm-dd") & ".doc"),FileFormat:=wdFormatDocument,LockComments:=False,Password:="",AddToRecentFiles:=True,WritePassword:="",ReadOnlyRecommended:=False,EmbedTrueTypeFonts:=False,SaveNativePictureFormat:=False,SaveFormsData:=False,SaveAsAOCELetter:=False Appword.Documents.Close Appword.Quit MsgBox "导出成功," & rs!姓名 & Format(Now,"yyyy-mm-dd") & "的资料保存于" & vbCrLf & vbCrLf & App.path + "/导出WORD文件夹" End If Set Appword = Nothing ‘交还控制权 Set Newword = Nothing Newword.Close rs.Close ’关闭数据库
注意事项:
1 以上是基本的操作,如果想在VB中对WORD操作。可以在WORD中录制宏看一下代码,然后复制过来稍作修改即可。
2 上面的代码中用到的模版是之前设置好表格。
.Tables(1).Cell(1,1).Range.Text 这个意思是在表格1中的第一个表格的内容
3 导出完毕后主要交还控制权。
4 这段代码运行时确保电脑中没有运行WORD程序,不然会弹出“由于应用程序忙。。。”所以在到处前应判断程序中是否运行WORD程序。
判断代码如下:
'在通用写入如下代码。
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long,ByVal th32ProcessID As Long) As Long Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long,lppe As PROCESSENTRY32) As Long Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long,lppe As PROCESSENTRY32) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long,ByVal blnheritHandle As Long,ByVal dwAppProcessId As Long) As Long Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long,ByVal uExitCode As Long) As Long Private Type PROCESSENTRY32 dwSize As Long cntUsage As Long th32ProcessID As Long th32DefaultHeapID As Long th32ModuleID As Long cntThreads As Long th32ParentProcessID As Long pcPriClassBase As Long dwFlags As Long szExeFile As String * 1024 End Type Const TH32CS_SNAPHEAPLIST = &H1 Const TH32CS_SNAPPROCESS = &H2 Const TH32CS_SNAPTHREAD = &H4 Const TH32CS_SNAPMODULE = &H8 Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE) Const TH32CS_INHERIT = &H80000000 Dim pid As Long
Private Sub Closeword() '关闭系统中运行的WORD Dim my As PROCESSENTRY32 Dim l As Long Dim l1 As Long Dim mName As String Dim i As Integer l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0) If l Then Y.dwSize = 1060 If (Process32First(l,my)) Then '遍历第一个进程 Do i = InStr(1,my.szExeFile,Chr(0)) mName = LCase(Left(my.szExeFile,i - 1)) If Trim(mName) = "winword.exe" Then '这里填你调用的程序进程名 pid = my.th32ProcessID Dim mProcID As Long mProcID = OpenProcess(1&,-1&,pid) TerminateProcess mProcID,0& Exit Sub End If Loop Until (Process32Next(l,my) < 1) '遍历所有进程知道返回值为False End If l1 = CloseHandle(l) End If End Sub
Private Sub Command1_Click()
Dim o As Object Set o = GetObject(,"Word.Application") If o Is Nothing Then Set o = Nothing Else sc = MsgBox("程序检测到您的系统中正在运行着“word”程序,请先保存,按确定以后会自动关闭所有word程序!",vbOKCancel + vbQuestion,提示) If sc = 1 Then Closeword Else Exit Sub End If End If
......这里填写导出WORD的代码。
End sub
原帖:
http://topic.csdn.net/u/20091102/10/03b90cf2-2254-4b41-8c43-094bc882527d.html 2f (编辑:李大同)
【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!
|