Sub test()
'
' test Macro
' 宏在 2007-7-16 由 FtpDown 录制

'插入表格
    Dim filename As String, str1() As String, tmp As String, i As Integer
    Dim photoimg As String, gisimg As String
   
    filename = "c:\set.txt" '这里是文本文件所在路径位置
    Open filename For Input As 1
    Do Until EOF(1)
    Line Input #1, tmp
    str1 = Split(tmp, ",")
    photoimg = str1(2) & "\1.jpg"
    gisimg = str1(2) & "\2.jpg"
   
    Selection.Collapse Direction:=wdCollapseStart
    Set myTable = ActiveDocument.Tables.Add(Range:=Selection.Range, _
    NumRows:=2, NumColumns:=3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
    wdAutoFitFixed)
       
    '修改表格的高宽
    myTable.Rows(1).HeightRule = wdRowHeightAtLeast
    myTable.Rows(1).Height = CentimetersToPoints(8.62)
   
    myTable.Columns(1).PreferredWidthType = wdPreferredWidthPoints
    myTable.Columns(1).PreferredWidth = CentimetersToPoints(12)
    myTable.Columns(2).PreferredWidthType = wdPreferredWidthPoints
    myTable.Columns(2).PreferredWidth = CentimetersToPoints(0.42)
    myTable.Columns(3).PreferredWidthType = wdPreferredWidthPoints
    myTable.Columns(3).PreferredWidth = CentimetersToPoints(12.32)
   
    myTable.Rows(2).HeightRule = wdRowHeightAtLeast
    myTable.Rows(2).Height = CentimetersToPoints(8.62)
   
    '合并表格
    myTable.Cell(Row:=1, Column:=2).Merge _
            MergeTo:=myTable.Cell(Row:=2, Column:=2)

    myTable.Cell(Row:=1, Column:=3).Merge _
            MergeTo:=myTable.Cell(Row:=2, Column:=3)

    '插入图片
    myTable.Cell(Row:=1, Column:=1).Range.InlineShapes.AddPicture filename:= _
        photoimg, LinkToFile:=False, _
         SaveWithDocument:=True
        
    myTable.Cell(Row:=1, Column:=1).Range.InlineShapes(1).Height = 244.35
    myTable.Cell(Row:=1, Column:=1).Range.InlineShapes(1).Width = 344.25
   
   
    myTable.Cell(Row:=2, Column:=1).Range.InlineShapes.AddPicture filename:= _
        photoimg, LinkToFile:=False, _
         SaveWithDocument:=True
        
    myTable.Cell(Row:=2, Column:=1).Range.InlineShapes(1).Height = 244.35
    myTable.Cell(Row:=2, Column:=1).Range.InlineShapes(1).Width = 344.25
   
    myTable.Cell(Row:=1, Column:=3).Range.InlineShapes.AddPicture filename:= _
        gisimg, LinkToFile:=False, _
         SaveWithDocument:=True
        
    myTable.Cell(Row:=1, Column:=3).Range.InlineShapes(1).Height = 498.7
    myTable.Cell(Row:=1, Column:=3).Range.InlineShapes(1).Width = 344.25
   
   
    '插入文本框
    Set myTB1 = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 71, 35, 172, 36)
    myTB1.TextFrame.TextRange = str1(1) & Chr(13) & "部件编码:" & str1(0)
   
    Set myTB2 = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 609, 509, 165, 22)
    myTB2.TextFrame.TextRange = "XXXXXXXXX   2007年7月"
   
    'Set arrPic = ActiveDocument.Shapes.AddPicture("D:\我的文档\My Pictures\88888\arrow.gif", False, True, 50, 300)
   
    Selection.MoveDown Unit:=wdLine, Count:=2
    Selection.TypeParagraph
Loop
Close
End Sub
Sub sx()
'
' sx Macro
' 宏在 2007-7-18 由 zwx 创建
'
Dim tmp As String, FileNumber As Integer

Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\Errmeilan.txt", True)
Set b = fs.CreateTextFile("c:\OKmeilan.txt", True)
filename = "c:\meilan.txt" '这里是文本文件所在路径位置
FileNumber = FreeFile
Open filename For Input As FileNumber
Do Until EOF(FileNumber)
    Line Input #FileNumber, tmp
    str1 = Split(tmp, ",")
    photoimg = str1(2) & "\001.jpg"
    gisimg = str1(2) & "\002.jpg"
   
    If fs.FileExists(photoimg) = True And fs.FileExists(gisimg) = True Then
       b.writeLine (tmp)
    Else
       a.writeLine (tmp)
    End If
Loop
a.Close
b.Close
Set fs = Nothing
Set a = Nothing
Set b = Nothing
End Sub

转自：http://blog.sina.com.cn/s/blog_3f59eb3d01000aqn.html