- Foxtable(狐表) (http://www.foxtable.com/bbs/index.asp)
-- 专家坐堂 (http://www.foxtable.com/bbs/list.asp?boardid=2)
---- 求帮助写段从Word读取数据的代码。 (http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=71352)
-- 发布时间：2015/7/9 19:45:00
-- 求帮助写段从Word读取数据的代码。
有多个WORD表格，现要用文件窗口批量选择表格，并将表格中蓝色部分数据及相片导入数据库，求帮写段代码，谢谢！
此主题相关图片如下：001.png
-- 发布时间：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
-- 发布时间：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
-- 发布时间：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
-- 发布时间：2015/7/9 22:03:00
--
非常感谢，我先学习一下，不明白再求教！
-- 发布时间：2015/7/21 22:14:00
--
有个小问题，简历信息读出来后，原来是分多行的，现在段落都没了，如何保留原有段落，怎么解决？
此主题相关图片如下：qq图片20150721220840.png
此主题相关图片如下：qq图片20150721220820.png
-- 发布时间：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)
-- 发布时间：2015/7/21 23:37:00
--
可以了，谢谢！
-- 发布时间：2016/7/16 14:54:00
--
mark一下 太牛了，从word提取数据
-- 发布时间：2016/8/8 19:14:00
--
大红袍老师的代码太好了，可以节省我们很大的录入工作量。