Foxtable(狐表)用户栏目专家坐堂 → 求帮助写段从Word读取数据的代码。


  共有10858人关注过本帖树形打印复制链接

主题:求帮助写段从Word读取数据的代码。

帅哥哟,离线,有人找我吗?
lhlh
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:211 积分:1997 威望:0 精华:0 注册:2014/11/11 10:23:00
求帮助写段从Word读取数据的代码。  发帖心情 Post By:2015/7/9 19:45:00 [只看该作者]

有多个WORD表格,现要用文件窗口批量选择表格,并将表格中蓝色部分数据及相片导入数据库,求帮写段代码,谢谢!


图片点击可在新窗口打开查看此主题相关图片如下:001.png
图片点击可在新窗口打开查看

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:从word取数据.rar



[此贴子已经被作者于2015/7/9 19:48:35编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
大红袍
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2015/7/9 20:18:00 [只看该作者]

 mark word读取图片

 

Dim app As New MSWord.Application
try
    Dim fileName = "C:\Documents and Settings\Administrator\My Documents\下载\从word取数据\从WORD取数据\黄某某.doc"
    Dim doc = app.Documents.Open(fileName)
    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("d:\test.jpg")
        End If
    Next
catch ex As exception
    msgbox(ex.message)
finally
    app.Quit
End try


 回到顶部
帅哥哟,离线,有人找我吗?
大红袍
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2015/7/9 20:22:00 [只看该作者]

 读取某个单元格的值,参考

 

Dim app As New MSWord.Application
try
    Dim fileName = "C:\Documents and Settings\Administrator\My Documents\下载\从word取数据\从WORD取数据\黄某某.doc"
    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)
    msgbox(text)
catch ex As exception
    msgbox(ex.message)
finally
    app.Quit
End try


 回到顶部
帅哥哟,离线,有人找我吗?
大红袍
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2015/7/9 20:31:00 [只看该作者]

 按钮代码

 

Dim dlg As new OpenFileDialog
dlg.MultiSelect = True
If dlg.ShowDialog = DialogResult.OK Then
    Dim app As New MSWord.Application
    try
        If FileSys.DirectoryExists(ProjectPath & "Attachments") = False Then
            FileSys.CreateDirectory(ProjectPath & "Attachments/")
        End If
        For Each filename As String In dlg.FileNames
           
            Dim doc = app.Documents.Open(fileName)
            Dim nr As Row = Tables("个人信息表").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
        Next
    catch ex As exception
        msgbox(ex.message)
    finally
        app.Quit
    End try
End If


 回到顶部
帅哥哟,离线,有人找我吗?
lhlh
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:211 积分:1997 威望:0 精华:0 注册:2014/11/11 10:23:00
  发帖心情 Post By:2015/7/9 22:03:00 [只看该作者]

非常感谢,我先学习一下,不明白再求教!图片点击可在新窗口打开查看

 回到顶部
帅哥哟,离线,有人找我吗?
lhlh
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:211 积分:1997 威望:0 精华:0 注册:2014/11/11 10:23:00
  发帖心情 Post By:2015/7/21 22:14:00 [只看该作者]

有个小问题,简历信息读出来后,原来是分多行的,现在段落都没了,如何保留原有段落,怎么解决?

如图:原WROD表格简历信息分为多行:

图片点击可在新窗口打开查看此主题相关图片如下:qq图片20150721220840.png
图片点击可在新窗口打开查看

现在段落没有了:

图片点击可在新窗口打开查看此主题相关图片如下:qq图片20150721220820.png
图片点击可在新窗口打开查看


            Dim text1 = t.Cell(5, 2).Range.Text.ToString()
            text1 = text1.Substring(0, text1.Length - 2)   
            nr("简历") = text1
[此贴子已经被作者于2015/7/21 22:15:10编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
大红袍
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:贵宾 帖子:39310 积分:196782 威望:0 精华:1 注册:2015/4/25 9:23:00
  发帖心情 Post By:2015/7/21 22:23:00 [只看该作者]

    Dim t = doc.Tables(1)
    Dim text = t.Cell(3, 2).Range.Text.ToString()
    text = text.Substring(0, text.Length - 2)
    text = text.replace(chr(13), vbcrlf)
    msgbox(text)

 回到顶部
帅哥哟,离线,有人找我吗?
lhlh
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:211 积分:1997 威望:0 精华:0 注册:2014/11/11 10:23:00
  发帖心情 Post By:2015/7/21 23:37:00 [只看该作者]

可以了,谢谢!

 回到顶部
帅哥哟,离线,有人找我吗?
飞飞
  9楼 | QQ | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:三尾狐 帖子:621 积分:5130 威望:0 精华:1 注册:2014/8/7 6:56:00
  发帖心情 Post By:2016/7/16 14:54:00 [只看该作者]

 mark一下 太牛了,从word提取数据

 回到顶部
帅哥哟,离线,有人找我吗?
lake163
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:276 积分:2971 威望:0 精华:0 注册:2010/9/20 11:21:00
  发帖心情 Post By:2016/8/8 19:14:00 [只看该作者]

大红袍老师的代码太好了,可以节省我们很大的录入工作量。
有两个问题请教:

    1、Dim doc = app.Documents.Open(fileName) 这一句在我的台式电脑上运行正常,但在笔记本上就出现问题。提示如下:
          (无法上传附件)
         无法将类型为“Microsoft.office.interop.Word.ApplicationClass"的COM 对象强制转换为接口类型:“Microsoft.office.interop.Word.Application“。此操作失败原因是对IID为{00020970-0000-0000-C000-0000000046} 的操作的COM组件调用 QueryInterface 因以下错误页失败:加载类型库/DLL时出错。

    2、照片有的可以识别,有的不能识别。
   (无法上传附件)








 回到顶部
总数 29 1 2 3 下一页