使用 Excel VBA 从 Access 中提取图片.jpg 或 .png

如何解决使用 Excel VBA 从 Access 中提取图片.jpg 或 .png

我想从 Access 的附件字段将图片（.jpg、.png）插入到 Excel 工作表中。

我目前的代码是这样的：

Sub InsertPicFromAccessDB()

    Dim con As ADODB.Connection
    Dim rs As ADODB.Recordset
    
    Set con = New ADODB.Connection
    Set rs = New ADODB.Recordset
    
    con.ConnectionString = ConStrAccess
    con.Open
    
    
    With rs
        .ActiveConnection = con
        .source = "SELECT ProdutoFoto FROM tblProduto WHERE ProdutoFoto=2163150;"
        .LockType = adLockOptimistic
        .CursorType = adOpenKeyset
        .Open
        
    End With
    
    shStockNovo.Range("A57").Value = rs.Fields(0).Value
    rs.Close
    con.Close
End Sub

它不会从数据库上传图像。

我已经搜索了其他替代方案，其中一个建议是使用 ADODB.Sream。但是它在“ADODB.Stream.Write”上给了我一个错误（根据我的研究，没有人可以解决这个问题）。这是“运行时错误‘3001’参数类型错误、超出可接受范围或相互冲突。”

解决方法

在 Excel VBA 中编写代码以从 Access 附件字段中提取图像文件并保存到文件夹，然后嵌入到 Excel 工作表中。

首先为Microsoft DAO x.x 对象库或Microsoft Office x.x Access数据库引擎对象库
设置一个引用
示例代码

Dim ws As DAO.Workspace
Dim db As DAO.Database
Dim rs As DAO.Recordset,rsP As Variant,strFile As String
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase("C:\path\filename.accdb")
Set rs = db.OpenRecordset("SELECT ProdutoFoto FROM tblProduto WHERE ProdutoFoto=2163150")
Set rsP = rs.Fields("ProdutoFoto").Value
rsP.Fields("FileData").SaveToFile "C:\Path"
strFile = rsP.Fields("FileName")
shStockNovo.Range("A57").Select
shStockNovo.Pictures.Insert ("C:\path\" & strFile)