附件访问VBA

-2

我已经创建了一个表单，其中包含附件字段，屏幕截图以.jpg格式附加。我正在尝试编写一些VBA代码来自动执行电子邮件过程以从表单发送电子邮件，我希望能够将截屏附加到电子邮件（已附加在表单上的那个）有没有办法做这个。我尝试使用.attachment.add me.attachmentfield。但是，这并没有附加任何东西到电子邮件。请告知如何做到这一点。

另外在另一个问题，我使用组合框来选择一个人发送电子邮件，（这是存储在另一个表与电子邮件地址一起）我无法获取电子邮件中的框中填充并选择个人的电子邮件地址。请告知如何做到这一点。

在此先感谢。

乔希

来源

2017-04-22 Josh

必须先将图像从数据库中导出并保存为图像文件，然后才能将该文件附加到电子邮件中。评论http://stackoverflow.com/questions/39382384/ms-access-how-to-export-attachments-images-with-a-given-name-to-a-folder – June7

其实访问连接字段不是电子邮件附件。 Access没有在电子邮件客户端的生成，所以你必须使用一个电子邮件客户端库像CDO或Outlook对象库：

Public Function SendEmail(strRecipients As String, strSubject As String, _ 
     Optional strBody As String, Optional strFilePath As String, _ 
     Optional strFileExtension As String) As String 

    On Error GoTo ProcError 

    Dim myObject As Object 
    Dim myItem As Object 
    Dim strFullPath As String 
    Dim strFileName As String 
    Dim strAttachPath As Variant 
    Dim intAttachments As Integer 

    Set myObject = CreateObject("Outlook.Application") 
    Set myItem = myObject.CreateItem(0) 

    With myItem 
     .Subject = strSubject 
     .To = strRecipients 

     If Len(Trim(strBody)) > 0 Then 
      .body = strBody 
     End If 

     If Len(Trim(strFileExtension)) = 0 Then 
      strFileExtension = "*.*" 
     End If 

     If Len(strFilePath) > 0 Then 
      strFullPath = strFilePath & "\" & strFileExtension 

      If Len(Trim(strFullPath)) > 0 Then 'An optional path was included 
       strFileName = Dir(strFullPath) 
       Do Until strFileName = "" 
        intAttachments = intAttachments + 1 
        strAttachPath = (strFilePath & "\" & strFileName) 
        .Attachments.add (strAttachPath) 
        ' Debug.Print strAttachPath 
        strFileName = Dir() 
       Loop 
      End If 
     End If 

     .Send 
     SendEmail = "Message placed in outbox with " & intAttachments & " file attachment(s)." 
    End With 

ExitProc: 
    Set myItem = Nothing 
    Set myObject = Nothing 
    Exit Function 
ProcError: 
    MsgBox "Error " & Err.Number & ": " & Err.Description, _ 
       vbCritical, "Error in SendMail Function..." 
    SendEmail = "A problem was encountered attempting to automate Outlook." 
    Resume ExitProc 

End Function

使用Field.SaveToFile转储访问附着到临时文件。

来源

2017-04-22 21:27:17 user3305711

附件访问VBA

回答

相关问题