Hey guys,
Im having trouble with Outlook not sending all emails, after the code below is executed. The Outlook application is closed most of the time before I start the code and that will be usually the case, when its opened all emails send normally after the code execution. However, as I said before if its not opened before the code starts it doesnt want to send all emails, when I open Outlook after the code some emails are still in Outbox folder and send a bit after but if I dont open Outlook they will stay in Outbox folder until I do it so.
The .Display I added because of the signature which I need in the email and I didnt find another way to add it which is not so complicated for me.
Thats the code I use. I read somewhere that the .GetInspector would help but I dont know it just didnt, or I didnt use it right whats more possible.
Thanks!
Im having trouble with Outlook not sending all emails, after the code below is executed. The Outlook application is closed most of the time before I start the code and that will be usually the case, when its opened all emails send normally after the code execution. However, as I said before if its not opened before the code starts it doesnt want to send all emails, when I open Outlook after the code some emails are still in Outbox folder and send a bit after but if I dont open Outlook they will stay in Outbox folder until I do it so.
The .Display I added because of the signature which I need in the email and I didnt find another way to add it which is not so complicated for me.
Code:
Private Sub cmdSendEmail_Click() '20190403
Dim MyRs1 As Recordset
Dim FileName As String
Dim emailText As String
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim outlookStarted As Boolean
'Dim myInspector As Outlook.Inspector
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
Set outApp = CreateObject("Outlook.Application")
outlookStarted = True
End If
Set MyDb = CurrentDb
Set MyQry = MyDb.QueryDefs("qryQueryWhichContainsReceivers")
MyQry.Parameters("[Forms]![frmName1]![IDOfReading]") = [Forms]![frmName1]![IDOfReading]
MyQry.Parameters("[Forms]![frmName1]![cboNetwork]") = [Forms]![frmName1]![cboNetwork]
Set MyRs1 = MyQry.OpenRecordset
If Not MyRs1.EOF Then
MyRs1.MoveFirst
While Not MyRs1.EOF
If InStr(MyRs1!FirstOfEmail, "@") = 0 Or InStr(MyRs1!FirstOfEmail, ".") = 0 Or IsNull(MyRs1!FirstOfEmail) Then
MsgBox "For " & MyRs1!CustName & ", ID of customer: '" & MyRs1!IdCustomer & "' the email is invalid or not entered"
Exit Sub
End If
MyRs1.MoveNext
Wend
End If
Set MyQry = MyDb.QueryDefs("qryQueryWhichContainsReceivers")
MyQry.Parameters("[Forms]![frmName1]![IDOfReading]") = [Forms]![frmName1]![IDOfReading]
MyQry.Parameters("[Forms]![frmName1]![cboNetwork]") = [Forms]![frmName1]![cboNetwork]
Set MyRs1 = MyQry.OpenRecordset
If Not MyRs1.EOF Then
MyRs1.MoveFirst
While Not MyRs1.EOF
FileName = Format(MyRs1!IdCustomer, "000000") & "_" & Left(MyRs1!CurrentDate, 2) & "_" & Right(MyRs1!CurrentDate, 2)
FilePath = "D:\Email_PDF\" & Right(MyRs1!CurrentDate, 4) & "year\" & FileName & ".pdf"
emailText = emailText & _
"Some text"
Set outMail = outApp.CreateItem(olMailItem)
With outMail
.To = MyRs1!FirstOfEmail
.Subject = "Receipt for " & MyRs1!CurrentDate & ""
.Display
'Set myInspector = .GetInspector
.HTMLBody = emailText & outMail.HTMLBody
.Attachments.Add FilePath
.Send
End With
emailText = ""
MyRs1.MoveNext
Wend
If outlookStarted Then
outApp.Quit
End If
MsgBox "All E-mails have been sent"
End If
End Sub
Thats the code I use. I read somewhere that the .GetInspector would help but I dont know it just didnt, or I didnt use it right whats more possible.
Thanks!