- Foxtable(狐表) (http://foxtable.com/bbs/index.asp)
-- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2)
---- [求助]doc文字和图片提取 (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=176143)
-- 发布时间：2022/4/1 12:41:00
-- [求助]doc文字和图片提取
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:提取文字图片到表a.zip |
求助表a导入外部文档的文字、图片到第一列、第二列（图片保存在Attachments文件夹）
-- 发布时间：2022/4/1 13:34:00
--
参考
http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=71352&skin=0
-- 发布时间：2022/4/1 13:58:00
-- 回复：（有点蓝）参考http://www.foxtable.com/bbs/di...
就是看到蓝主上楼你发的这个项目，不知道怎么修改，才求助
上楼项目是从表里面提取，不懂怎么修改
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("表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
Next
catch ex As exception
msgbox(ex.message)
finally
app.Quit
End try
End If
-- 发布时间：2022/4/1 14:23:00
--
Dim dlg As new OpenFileDialog
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
Dim doc = app.Documents.Open(dlg.FileName)
Dim nr As Row = Tables("表A").AddNew
For Each k As object In doc.Paragraphs
nr("第一列") = nr("第一列") & k.Range.text
Next
\'nr("第一列") = text
\'-------------
Dim lst As new List(of String)
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))
Dim f As String = format(Date.now,"yyyyMMddHHmmssfffff") & ".jpg"
bmp.Save(ProjectPath & "Attachments/" & f)
lst.add(f)
End If
Next
nr.DataRow.Lines("第二列") = lst
Doc.Close
catch ex As exception
msgbox(ex.message)
finally
app.Quit
End try
End If
-- 发布时间：2022/4/1 16:47:00
-- 回复：（有点蓝）Dim dlg As new OpenFileDialogIf dl...
蓝主，求助，提取的图片放在，姓名，这个文件夹里面
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:提取文字图片到表a - w.foxdb |
-- 发布时间：2022/4/1 16:49:00
--
保存到哪里自己改保存的路径即可
bmp.Save("保存的路径比如c:\\abc\\abc.jpg")
-- 发布时间：2022/4/1 17:00:00
-- 回复：（有点蓝）保存到哪里自己改保存的路径即可bmp....
bmp.Save(ProjectPath & "Attachments\\" & nr("姓名") & f)
上面代码，提取的图片，放在Attachments的1级文件夹里面不是想要的效果。
想实现，提取的图片，放在Attachments 下面的2级文件夹里面 （当前行 姓名，这个文件夹），下面代码报错：未将对象引用设置到对象的实例
bmp.Save(ProjectPath & "Attachments\\" & nr("姓名") & "\\" & f)
[此贴子已经被作者于2022/4/1 17:00:14编辑过]
-- 发布时间：2022/4/1 17:04:00
--
参考：http://www.foxtable.com/webhelp/topics/0332.htm
4楼代码也有CreateDirectory的用法，自己参考创建目录