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

Question

我想从 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’参数类型错误、超出可接受范围或相互冲突。”

Answer 1

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

1. 首先为 Microsoft DAO x.x 对象库或 Microsoft Office x.x Access 数据库引擎对象库

   设置引用

2. 示例代码

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)