Question

对不起，我在这里有点新鲜。我花了好几天时间尝试合并我当前的代码，该代码可以根据表单中的信息发送电子邮件。就像＆＃34;发送电子邮件＆＃34;按钮。它预先填充了正确的信息，但是，我的记录集有附件，我似乎无法正确编码。我已经阅读了过去5天的附件代码，我似乎无法理解如何将它合并到我当前的代码中。我只想将保存在我的记录中的附件包含在我的电子邮件中。这是我目前的代码，有人可以告诉我如何在其中包含附件代码吗？非常感谢你提前!!

    Private Sub btnEmail_Click()

      Dim objOutlook As Object
      Dim objOutlookMsg As Object
      Dim objOutlookRecip As Outlook.Recipient
      Dim objOutlookAttach As Outlook.Attachment

      ' Create the Outlook session.
      Set objOutlook = CreateObject("Outlook.Application")

      ' Create the message.
      Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

      With objOutlookMsg
          ' Add the To recipient(s) to the message.
          Set objOutlookRecip = .Recipients.Add("Nancy Davolio")
          objOutlookRecip.Type = olTo

          ' Add the CC recipient(s) to the message.
          Set objOutlookRecip = .Recipients.Add("Michael Suyama")
          objOutlookRecip.Type = olCC

         ' Add the BCC recipient(s) to the message.
          Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
          objOutlookRecip.Type = olBCC

         ' Set the Subject, Body, and Importance of the message.
         .Subject = "This is an Automation test with Microsoft Outlook"
         .Body = "This is the body of the message."
         .Importance = olImportanceHigh  'High importance


         ' Resolve each Recipient's name.
         For Each objOutlookRecip In .Recipients
             objOutlookRecip.Resolve
         Next

         ' Should we display the message before sending?

             .Display

            ' .Save
            ' .Send

      End With
      Set objOutlook = Nothing

    End Sub


    Function SaveAttachment()
 Dim db As DAO.Database
 Dim rst As DAO.Recordset2
 Dim rstAttachment As DAO.Recordset2
 Dim fld As DAO.Field2
 Dim strPath As String
 Dim intz As Integer

Set db = CurrentDb
     Set rst = db.OpenRecordset("site inspections table", dbOpenDynaset)
     rst.FindFirst "ID = " & Me!ID
      Set rstAttachment = rst.Fields("Photos").Value
     Set fld = rstAttachment.Fields("Filedata")
     strPath = CurrentProject.Path & "\Attach\" _
     & rstAttachment.Fields("Filename")
     On Error Resume Next
     Kill strPath & "\Attach\"
     On Error GoTo 0

     fld.SaveToFile strPath

 rstAttachment.Close
 rst.Close
 Set rstAttachment = Nothing
 Set rst = Nothing
 Set db = Nothing

End Function

Private Sub cmdEmail_Click()
 Dim outlookApp As Outlook.Application
 Dim outlookNamespace As NameSpace
 Dim objMailItem  As MailItem
 Dim objFolder As MAPIFolder
 Dim strAttachementPath As String
 Dim rst As DAO.Recordset2
 Dim rstAttachment As DAO.Recordset2
 Dim db As DAO.Database
 Dim strHTML

'Call SaveAttachment
Set outlookApp = CreateObject("Outlook.Application")
 Set outlookNamespace = outlookApp.GetNamespace("mapi")
 Set objFolder = outlookNamespace.GetDefaultFolder(olFolderInbox)
 Set objMailItem = objFolder.Items.Add(olMailItem)
    Set db = CurrentDb
     Set rst = db.OpenRecordset("site inspections table", dbOpenDynaset)
     rst.FindFirst "ID = " & Me!ID
    Set rstAttachment = rst.Fields("Photos").Value
'strAttachementPath = CurrentProject.Path & "\Attach\" _
' & rstAttachment.Fields("Filename")

' Build HTML for message body.
 strHTML = "<HTML><HEAD>"
 strHTML = "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>ID: </b></br>" & [ID] & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Date: </b></br>" & [Date] & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Time: </b></br>" & [Time] & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Technician: </b></br>" & [Technician] & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Area: </b></br>" & [Area] & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Blast No.: </b></br>" & [shot number] & "<br><br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Comments: </b></br>" & [Comments] & "<br>"
 strHTML = strHTML & "</FONT></br><BODY>"
'strHTML = strHTML & "<FONT Face=Arial Color=#ff0000 Size=5>Job #: 123456</FONT></br>"
'strHTML = strHTML & "<FONT Size=3>For: <FONT Size=2></B>a name here</br>"
'strHTML = strHTML & "<FONT Size=3><B>Description: </B><FONT Size=2>description of work to be                                         
 strHTML = strHTML & "</BODY></HTML>"

' Build the Email to be sent
With objMailItem
    .BodyFormat = olFormatHTML
    .To = "EMAIL ADDRESS HERE"
    .Subject = "Site Inspection for " & [Area] & " At " & [Date]
'    .Body = "Some text here"
    .HTMLBody = strHTML
' Grab Attachments for Email if there are any
    If rstAttachment.RecordCount > 0 Then
        Call SaveAttachment
        strAttachementPath = CurrentProject.Path & "\Attach\" _
        & rstAttachment.Fields("Filename")
        .Attachments.Add (strAttachementPath)
    End If
     .Display
 End With

 outlookApp.ActiveWindow
 'SendKeys ("%s")
MsgBox "Mail Sent!", vbOKOnly, "Mail Sent"

Answer 1

objOutlookMsg.Attachments.Add("c:\temp\MyTestFile.txt")

只需要。

使用基于表单记录集的访问权限向电子邮件添加附件

1 个答案: