有word vba 读取excel中存的word待合并路径,合并word文件

来源：互联网发布：ws2812b单片机程序编辑：程序博客网时间：2024/04/29 13:01

word文件合并
第一步:
在word中使用Ado
在vba中添加引用
Microsot ActiveX data Objects 2.8

第二步准备excel文件
样式如下:
文件标题 D:/test/1001.doc [一.基础知识]1，什么是VC？ D:/test/1002.doc [一.基础知识]2，什么是竞价？ D:/test/1003.doc [一.基础知识]3，什么是借力发展？ D:/test/1004.doc [一.基础知识]4，常见的编程语言？ D:/test/1005.doc [一.基础知识]5，网络三阶段是指的哪三阶段？ D:/test/1006.doc [一.基础知识]6，流量的分类？ D:/test/1007.doc [一.基础知识]7，什么是全民皆赚？ D:/test/1008.doc [一.基础知识]8，日流量10万IP程序原理是什么？ D:/test/1009.doc [一.基础知识]9，如何选购空间。 D:/test/1010.doc [一.基础知识]10，什么是正规站。 D:/test/1011.doc [一.基础知识]11，第三页和文本地址。 D:/test/1012.doc [一.基础知识]12，流量来源。
第三步：
执行vba源码
如下:

Sub Macro4()
'

    Dim adoConnection As New ADODB.Connection
    Dim adoRecordset As New ADODB.Recordset

    Dim ExcelName As String

    Dim MyDialog As FileDialog, oDoc As Variant, myDoc As Document, TestDoc As Document
    Dim myRange As Range, OldName As String, ErrArray() As Variant
    Dim oArray As Variant, NewName As String
    On Error Resume Next    '忽略错误
'    CommonDialog1.ShowOpen

    'Word.Documents.Open(FileName:="C:/Documents and Settings/User/桌面/"
    ChangeFileOpenDirectory "C:/Documents and Settings/User/桌面/"
     Set TestDoc = Word.Documents.Open(FileName:="test.doc", Visible:=True)

    ExcelName = "d:/obj.xls"
    'OLE DB + ODBC Driver 方式:
    'adoConnection.Open "Data Provider=MSDASQL.1;driver=Microsoft Excel Driver (*.xls);DBQ=e:/temp/book2.xls"
    'Microsoft.Jet.OLEDB.4.0 方式,(建?)
    adoConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & ExcelName & ";Extended Properties='Excel 8.0;HDR=Yes'"

    adoRecordset.Open "select * from [sheet1$]", adoConnection, adOpenKeyset, adLockOptimistic
    Debug.Print adoRecordset.RecordCount
    Dim i As Integer
    Do Until adoRecordset.EOF
        'For i = 0 To adoRecordset.Fields.Count - 1
            'Debug.Print adoRecordset.Fields.Item(0).Name
         '   Debug.Print adoRecordset.Fields.Item(i).Value


        'Next i
        '读取excel字段内容，整个一列
        'Debug.Print adoRecordset.Fields.Item(0).Value
        'Debug.Print adoRecordset.Fields.Item(1).Value


                    '以隐藏方式打开Word文档
            Set myDoc = Word.Documents.Open(FileName:=adoRecordset.Fields.Item(0).Value, Visible:=True)

           Selection.WholeStory

           Selection.Copy

           Windows(TestDoc).Activate

           Selection.TypeParagraph
           Selection.Font.Color = wdColorRed
            Selection.TypeText Text:=adoRecordset.Fields.Item(1).Value

            Selection.TypeParagraph
            Selection.TypeParagraph
            Selection.Font.Color = wdColorAutomatic
            Selection.PasteAndFormat (wdPasteDefault)

            ActiveDocument.Save
          ' Set myRange = myDoc.Paragraphs.First.Range '取得第1个段落区域
           ' OldName = Application.CleanString(myRange.Text) '清除非打印字符

            myDoc.Close False '关闭文档

        adoRecordset.MoveNext
    Loop




End Sub