VBA操作Word,Excel,Access

来源:excel02110217    发布时间:2019-11-17 17:02:53

碎不着觉了,把前段时间做的一个东东,改改做个示例,有需要VBA联合操作EXCEL,Word,Access的阔以参考一下,示例很简单,大致就是把EXCEL中的数据当做查询关键字,在ACCESS数据库中根据这些关键字查询相应的内容,然后把结果写入一个WORD文档,保存!

EXCEL里面的数据很简单,就一列人名字,一会儿要根据这些名字在ACCESS里面查询相应的电话号码

ACCESS里面只有一个表,有三个字段,id,phone,name

下面是代码,我把每个功能封装在一个函数或者过程里面,这样代码看起来比较清晰也便于维护!


------------------代码是放在EXCEL的VBE里面的哈----------

Option Explicit

Public Const wdStory As Integer = 6

'--------------------------------------------------------------------

'主过程main,作用是遍历EXCEL当前表中的关键字数据,然后查询,整理查询结果,调用写入WORD过程!

Sub main()

Dim AccessPath As String, WordPath As String

Dim rng As Range, dataRng As Range

Dim res As String, tmp As String

AccessPath = findpath(1): WordPath = findpath(2)

If AccessPath = "0" Or WordPath = "0" Then

MsgBox "Word或者Access文件路径为空,请重选!", "路径没有选择!"

Exit Sub

End If

Set dataRng = ThisWorkbook.ActiveSheet.UsedRange

For Each rng In dataRng

tmp = query(rng.Value, AccessPath)

If tmp <> "0" Then

res = res & tmp & vbCrLf

Else

res = res & rng.Value & " _ 没有查到" & vbCrLf

End If

Next rng

Call insert_word(res, WordPath)

End Sub

'------------------------------------------

'此过程用于把查询到的结果写入一个WORD文档中

Private Sub insert_word(ByVal str As String, ByVal path As String)

Dim wd As Variant

Set wd = CreateObject("word.application")

With wd

.Visible = True

.documents.Open path

.Selection.EndKey Unit:=wdStory

.Selection.TypeText Text:=str & vbCrLf

.ActiveDocument.Save

.ActiveDocument.Close

.Quit

End With

Set wd = Nothing

End Sub

'-----------------------------------------------------------------

'手机号查询,也就是用EXCEL_VBA操作ACCESS数据库,封装在query函数里面

Private Function query(ByVal nam As String, ByVal path As String)

Dim con As Variant, rst As Variant

Dim sql As String

Set con = CreateObject("adodb.connection")

'con.Open "DRIVER={Microsoft Access Driver (*.mdb:*.accdb)};DBQ=" & path

'上面这种方式连接数据库03版以前的EXCEL没问题,07以后得用下面这种驱动,我么有测试,估计得安装07版

'OFFICE里面的工具

con.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & path

sql = "select * from data where name='" & nam & "'"

Set rst = con.Execute(sql)

If rst.EOF Then

query = "0"

Else

query = rst(2) & " _ " & rst(1)

End If

con.Close

Set rst = Nothing

Set con = Nothing

End Function

'---------------------------------------------------------------------------

'寻找WORD和ACCESS文件的路径用到了FileDialog对象,我把这个功能封装在一个函数里面

'一个参数typ是为了确定要打开的文件类型1是打开ACCESS,2是打开WORD文件

Private Function findpath(ByVal typ As Integer)

Dim dalo As Variant

Dim tit As String, f_disc As String, f_str As String

Select Case typ

Case 1

tit = "选择ACCESS数据源"

f_disc = "ACCESS数据源文件"

f_str = "*.accdb;*.mdb"

Case 2

tit = "选择结果输出WORD文件"

f_disc = "WORD输出文件"

f_str = "*.doc;*.docm;*.docx"

Case Else

findpath = "0"

Exit Function

End Select

Set dalo = Application.FileDialog(msoFileDialogOpen)

With dalo

.Title = tit

.AllowMultiSelect = False

.Filters.Clear

.Filters.Add f_disc, f_str

If .Show = 0 Then

findpath = "0"

Exit Function

Else

findpath = .SelectedItems(1)

End If

End With

Set dalo = Nothing

End Function

----------------------------------代码结束---------------------

代码中用到了application.FileDialog(arg)对象,这个对象可以根据参数,打开“打开,保存”等对话框,我们用它指定Access源文件和WORD输出文件

所以运行中会先后打开俩个对话框 来指定文件,第一个是Access,第二个是Word。如下图


运行结果会放在我们指定的Word文件里面,如下图


所用源文件:http://pan.baidu.com/s/1c0EQgBe


碎了,安,这个鸟地方真冷!