Excel宏将jpg另存为附件

Posted 2023-05-07

【中文标题】Excel宏将jpg另存为附件

【英文标题】：Excel macro to save jpg as attachment

【发布时间】：2016-07-30 11:39:24

【问题描述】：

我迷失了这个话题。我将尝试解释我正在尝试做的事情： - 我的想法是能够将jpg文件上传或保存到我的access 2010数据库中，这个过程是由excel中的usign宏启动的。我在互联网上阅读了很多，但老实说我被困住了，我找不到一个例子。 我想使用 ADO 连接 我的想法是使用帖子标签，这个标签会有所不同，我的意思是，我想用这些图片打印这些标签。

您可以在下面看到我正在尝试做的事情。我迷路了，我得到了错误，也许如果有人有一个例子我可以调整它，因为我认为我无法使用我拥有的那个。

流程如下：

Sub SUBIRIMAGEN() 'To save a file in a table as binary


    Dim adoStream               As Object
    Dim adoCmd                  As Object
    Dim strFilePath             As String
    Dim adoCon                  As Object

    Const strServerName         As String = ""  'Server Name

    Set adoCon = CreateObject("ADODB.Connection")
    Set adoStream = CreateObject("ADODB.Stream")
    Set adoCmd = CreateObject("ADODB.Command")


    strDBName = "database1.accdb"
    strMyPath = ThisWorkbook.Path
    strDB = strMyPath & "\" & strDBName

'Connect to a data source:
'For pre - MS Access 2007, .mdb files (viz. MS Access 97 up to MS Access 2003), use the Jet provider: "Microsoft.Jet.OLEDB.4.0". For Access 2007 (.accdb database) use the ACE Provider: "Microsoft.ACE.OLEDB.12.0". The ACE Provider can be used for both the Access .mdb & .accdb files.




    '--Open Connection to SQL server
    adoCon.CursorLocation = adUseClient
    adoCon.Open ConnectionString:="Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDB
    Rem adoCon.Open "Provider=SQLOLEDB;Data Source=" & strServerName & ";Initial Catalog = " & strDB & ";Integrated Security=SSPI;"
    '----

    strFilePath = "C:\Users\pc2\Downloads\frutossecosgranel.JPG" ' File to upload

    adoStream.Type = adTypeBinary
    adoStream.Open
    adoStream.LoadFromFile strFilePath 'It fails if file is open

    With adoCmd
        .CommandText = "INSERT INTO table1 (id,attach) VALUES (?,?) " ' Query
        .CommandType = adCmdText

        '---adding parameters
        .Parameters.Append .CreateParameter("@Id", adInteger, adParamInput, 0, 1)
            .Parameters.Append .CreateParameter("@attach", adVarBinary, adParamInput, adoStream.Size, adoStream.Read)
        '---
    End With

    adoCmd.ActiveConnection = adoCon
        adoCmd.Execute

    adoCon.Close


End Sub

【参考方案1】：

使用以下代码将图像附加到 excel 中的数据库访问。

在excel中写这段代码

根据需要修改常量

 Private Sub AttachImage()
    Const dbname = "c:\temp\Db.accdb"
    Dim sql As String
    Dim db As Database
    Dim rst As Recordset2
    Dim rstImage As Recordset2
    Dim imageField As Field2
    Dim path As String
    Dim lnga As Integer
    Dim lngkey As Long
    path = "c:\temp\table.png"

    'select the row to be attached by image
    sql = "SELECT * FROM table2  WHERE ID =  1"
    Set db = DBEngine.Workspaces(0).OpenDatabase(dbname)
    Set rst = db.OpenRecordset(sql)

    Set imageField = rst!Blob  ' Blob is the field name to store attachment
    Set rstImage = imageField.Value
     rst.Edit
    rstImage.AddNew
    On Error Resume Next
    rstImage!FileData.LoadFromFile path
    If Err <> 0 Then
    MsgBox "Error: " + Err.Description, vbInformation, path
    Exit Sub
    End If
    rstImage.Update
    rst.Update

   Set rst = Nothing
   Set db = Nothing
End Sub