Here is the complete code. The SendKey is used as a work around for the Outlook security message. We send several emails at one time that have individual attachments depending to whom the email is being sent. So, if there are 50 e-mails then then attachments are for that person only. You might notice there is "Call sSleep" (seperate module) it's a time delay. It seems to work smoother when I open the message wait 2 seconds then send it.
Dim Atchfile As String
Dim IntFile As String
Dim Message As String
Dim App As Object
Dim ITM As Object
Dim DB As Database
Dim Regnme As Recordset
Dim Esubject As String
Dim SendTo As Variant
Dim Ebody As String
Dim NewFileName As String
Set Xfile = GetObject(, "Excel.application")
With Xfile.ActiveWorkbook
Atchfile = .Path
End With
If Me!Check15 <> -1 Then
Message = MsgBox("You Have Not Put A Check In The All Jurisdictions Selected Box Yet.", vbOKOnly)
GoTo Exit_CmdEstart_Click
End If
SendAuditPack
Insert54
CommonDialog1.CancelError = True
CommonDialog1.InitDir = Atchfile
CommonDialog1.Flags = &H1000& Or &H800&
CommonDialog1.Filter = "All PDF Files (*.pdf)|*.pdf|Word Files (*.doc)|*.doc"
CommonDialog1.DialogTitle = " Select The Interest Report. "
CommonDialog1.ShowOpen
IntFile = CommonDialog1.Filename
Set DB = CurrentDb
Set Regnme = DBEngine(0).Databases(0).OpenRecordset("qrypickJuris")
With Regnme
If .RecordCount > 0 Then
.MoveFirst
Do Until .EOF
Const ctime = 1500
Call sSleep(ctime)
SendTo = !EMailAddr 'SendTo & !EMailAddr & ";"
' .MoveNext
' Loop
' End If
'End With
Esubject = "IFTA Audit" & " " & !JurisID
Ebody = " The attached Audit Summary is for" & " " & Me.TxtTpName & ", " & "their license number is " & Me.TxtLinNo & " and covers the years " & Me.TxtYrs & "." _
& vbCrLf & vbCrLf & vbCrLf _
& " EMAIL Confidentiality: " _
& "This communication may contain privileged information. " _
& "If you are not the intended recipient, or believe that you may have " _
& "received this communication in error, please reply to the sender " _
& "indicating that fact and delete the copy you received. In addition, " _
& "you should not print, copy, retransmit, disseminate or otherwise use the information in this communication."
NewFileName = Atchfile & "\" & "IFTAJuris" & " " & !JurisID & ".pdf"
Set App = CreateObject("Outlook.Application")
Set ITM = App.CreateItem(olMailItem)
With ITM
.Subject = Esubject
.To = SendTo
.Body = Ebody
.Attachments.Add NewFileName
.Attachments.Add IntFile
.Display 'This opens the e-mail for viewing
' .Send 'This sends without opening the e-mail (you will get the prompt)
End With
Call sSleep(ctime)
SendKeys "%{s}", True 'This sends the e-mail (won't work if you are stepping through)
.MoveNext
Loop
End If
End With
Set Xfile = Nothing
Set ITM = Nothing
Set App = Nothing
Regnme.Close
Set Regnme = Nothing
End