Search code examples
excelvbaoutlook

VBA Outlook does not generate new mailitem from this code


When I go to sent emails with the code below it sends a previous version of the email. It doesn't reset.

Private Sub CommandButton16_Click()
Dim EmailApp As Outlook.Application
Dim EmailItem As Outlook.MailItem
Set EmailApp = New Outlook.Application

Dim EmailAddress As String
Dim EmpName As String
Dim ProvName As String
Dim PayMonth As String
Dim Filename As String
Dim Filepath As String
Dim FileExists As String
Dim Subject As String
Dim Source As String
Dim AltEmail As String
Dim ExtraMsg As String
Dim i As Long


'Loop through and get email address and names
    i = 2
    PayMonth = TextBox6.Value
    AltEmail = TextBox7.Value
    ExtraMsg = TextBox8.Value
    
Do While Worksheets("Provider Template").Cells(i, 1).Value <> ""
    ProvName = Worksheets("Provider Template").Cells(i, 1).Value
    EmpName = Worksheets("Provider Template").Cells(i, 11).Value
    If AltEmail = "" Then EmailAddress = Worksheets("Provider Template").Cells(i, 20).Value Else EmailAddress = AltEmail
    Filename = ProvName & " " & PayMonth
    Filepath = ThisWorkbook.Path & "\Remittance PDFs\"
    Source = Filepath & Filename & ".pdf"
    Subject = "Monthly Remittance Advice for" & " " & ProvName & " - " & PayMonth
    FileExists = Dir(Source)
    If FileExists = "" Then GoTo Lastline Else GoTo SendEmail
SendEmail:
    Set EmailItem = EmailApp.CreateItem(olMailItem)
    With EmailItem
    EmailItem.To = EmailAddress
    EmailItem.CC = "******************"
    EmailItem.Subject = Subject
    EmailItem.HTMLBody = "<html><body><p>Here is the tax invoice and calculation sheet for " & ProvName & ".</p><p>" & ExtraMsg & "</p><p>Kind regards, ******</p><p>****** ******</p><p>Practice Manager</p></body></html>"
    EmailItem.Attachments.Add Source
    EmailItem.Send
    End With
    GoTo Lastline
Lastline:
    i = i + 1
Loop
End Sub

I thought it was a problem in the code then I ran it on a different machine and fresh emails were sent. I uploaded the updated version to a work machine and the old emails are going again, like there is a cache of this stuff somewhere.


Solution

  • You can try to check your "Sent" box in outlook next time. It's possible that outlook did'nt sent them (offline or other reason),thety are still there as a draft. That could be the reason that they where sent later.

    And adjust: With EmailItem .To = EmailAddress And you can leave this out; GoTo Lastline Lastline: