VBA sending an email

[Mike2502]

Hey all,

The code below comes up with an error "Do without loop", not sure as it was working before but now its faulty

Also, is there any way to send an email using Sheet1 and Sheet2? They have the same headings required - I could stack all of the data into one worksheet but not sure how to but I presume using the sheet as a whole will be much efficient?

Please advise and thank you!

Sub Send_email()
    Dim edress1     As String
    Dim subject     As String
    Dim message     As String
    Dim receiver    As String
    Dim filename    As String
    Dim body        As String
    Dim outlookapp  As Object
    Dim outlookmailitem As Object
    Dim myAttachments As Object
    Dim path        As String
    Dim lastrow     As Integer
    Dim attachment  As String
    Dim x           As Integer
    
    Dim MyDate
    Dim Month
    Dim StrName     As String
    
    MyDate = Format(Date, "yyyymmdd")
    Month = Format(Date, "mmmm")
    
    x = 2
    Do Until ActiveCell(0, 5).Select
        Do Until ActiveCell.Value = ""
            
            Dim Answer As VbMsgBoxResult
            
            Answer = MsgBox("Are you sure you wish To send the email(s)?", vbYesNo, "Send Email")
            
            If Answer = vbYes Then
                
                Dim ws As Worksheet
                Set ws = ActiveSheet
                Do While ActiveSheet.Cells(x, 1) <> ""
                    
                    Set outlookapp = CreateObject("Outlook.Application")
                    Set outlookmailitem = outlookapp.createitem(0)
                    Set myAttachments = outlookmailitem.Attachments
                    path = "C:\Users\file\" & Month & "\"
                    
                    receiver = ActiveSheet.Cells(x, 14)
                    subject = ActiveSheet.Cells(x, 15)
                    filename = ActiveSheet.Cells(x, 13)
                    body = ActiveSheet.Cells(1, 16).Value
                    StrName = MyDate & " - " & filename
                    '.SentOnBehalfOfName = ""
                    attachment = path + StrName + ".pdf"
                    
                    outlookmailitem.To = receiver
                    
                    outlookmailitem.cc = ""
                    outlookmailitem.bcc = ""
                    outlookmailitem.subject = subject
                    outlookmailitem.body = body
                    myAttachments.Add (attachment)
                    outlookmailitem.send
                    lastrow = lastrow + 1
                    edress1 = ""
                    
                    x = x + 1
                Loop
                
                Set outlookapp = Nothing
                Set outlookmailitem = Nothing
                
            End If
        End Sub

 

[Fluff]

Duplicate mailmerge VBA

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread.
Per forum rules, posts of a duplicate nature will be locked or deleted (rule 12 here: Forum Rules).

If you do not receive a response, you can "bump" it by replying to it again, though we advise you to wait 24 hours before doing and not to bump a thread more than once a day.