以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  WORD导入表代码修改  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=103390)
--  作者：HJG_HB950207
--  发布时间：2017/7/6 22:44:00
--  WORD导入表代码修改
从D:\\LZXX1目录讲WORD 表格信息的姓名、照片自动批量导入表A 姓名、照片列。
用如下代码成功批量导入，但刚执行前会提示    “集合所要求的成员不存在“，后面不影响导入，请老师修改。谢谢！
For Each AAA As String In filesys .GetFiles("d:\\lzxx1")
Dim app As New MSWord.Application
try
    Dim fileName = AAA
    Dim doc = app.Documents.Open(fileName)
    Dim t = doc.Tables(1)
    Dim text = t.Cell(1, 2).Range.Text.ToString()
    text = text.Substring(0, text.Length - 2)
Dim nr As Row = Tables("表A").AddNew
            \'Dim t = doc.Tables(1)
           \' Dim text = t.Cell(1, 2).Range.Text.ToString()
           \' text = text.Substring(0, text.Length - 2)
            nr("姓名") = text
app.ActiveWindow.Selection.WholeStory
            For Each shape As object In app.ActiveWindow.Selection.InlineShapes
                If shape.Type = MSWord.WdInlineShapeType.wdInlineShapePicture
                    Dim img As Byte() = shape.Range.EnhMetaFileBits
                    Dim bmp As new Bitmap(new IO.MemoryStream(img))
                    bmp.Save(ProjectPath & "Attachments/" & nr("姓名") & ".jpg")
                End If
            Next
            nr("照片") = nr("姓名") & ".jpg"
            Doc.Close
catch ex As exception
    msgbox(ex.message)
finally
    app.Quit
End try
Next
--  作者：有点甜
--  发布时间：2017/7/6 23:38:00
--  

如果你的word文件没有表格，那么使用doc.tables(1)获取就会报错。

 

你可以判断表格个数 if doc.tables.count >= 1 then

 

For Each AAA As String In filesys .GetFiles("d:\\lzxx1")
    Dim app As New MSWord.Application
    try
        Dim fileName = AAA
        Dim doc = app.Documents.Open(fileName)
        Dim t = doc.Tables(1)
        Dim text = t.Cell(1, 2).Range.Text.ToString()
        text = text.Substring(0, text.Length - 2)
        Dim nr As Row = Tables("表A").AddNew
        \'Dim t = doc.Tables(1)
        \' Dim text = t.Cell(1, 2).Range.Text.ToString()
        \' text = text.Substring(0, text.Length - 2)
        nr("姓名") = text
        app.ActiveWindow.Selection.WholeStory
        For Each shape As object In app.ActiveWindow.Selection.InlineShapes
            If shape.Type = MSWord.WdInlineShapeType.wdInlineShapePicture
                Dim img As Byte() = shape.Range.EnhMetaFileBits
                Dim bmp As new Bitmap(new IO.MemoryStream(img))
                bmp.Save(ProjectPath & "Attachments/" & nr("姓名") & ".jpg")
            End If
        Next
        nr("照片") = nr("姓名") & ".jpg"
        Doc.Close
    catch ex As exception
        \'msgbox(ex.message)
    finally
        app.Quit
    End try
Next