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!
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!
VBA Code:
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