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

Question

我想从 Access 的附件字段中将图片 (.jpg,.png) 插入 Excel sheet。

我目前的代码是这样的：

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”的错误（根据我的研究，没有人能解决这个问题）。是“运行 Time Error ‘3001’ Arguments are the wrong type, are out of acceptable range, or are in conflict one other.”

Answer 1

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

首先为 Microsoft DAO x.x Object Library 或 Microsoft Office x.x Access Database Engine 设置引用对象库
示例代码

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)

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

Extract picture (.jpg or .png) from Access with Excel VBA

excel

ms-access

vba7