We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Sub SendEmail() 'Uses early binding 'Requires a reference to the Outlook Object Library Dim OutlookApp As Outlook.Application Dim MItem As Outlook.MailItem Dim olAppointment As Outlook.AppointmentItem Dim cell As Range Dim Subj As String Dim EmailAddr As String Dim Adate As Date Dim Atime As String Dim Msg2 As String Dim SendStatus As String 'Create Outlook object Set OutlookApp = New Outlook.Application 'Loop through the rows For Each cell In Columns("H").Cells.SpecialCells(xlCellTypeConstants) If cell.Value Like "*@*" Then 'Get the data SendStatus = cell.Offset(0, 1) If SendStatus <> "To be sent" Then GoTo NotThisOne Subj = cell.Offset(0, -1).Value EmailAddr = cell.Value Adate = cell.Offset(0, -6).Value Atime = cell.Offset(0, -5).Value FileLocation = "C:\ApptFiles\OutlookAppointment.ics" cell.Offset(0, 1).Value = "Sent" Dim olApp As Outlook.Application Dim olApt As AppointmentItem Set olApp = New Outlook.Application Set olApt = olApp.CreateItem(olAppointmentItem) Msg2 = "New Task" With olApt .Start = Adate .End = .Start + TimeValue("00:30:00") .Subject = Msg2 .Location = " " .Body = Msg .BusyStatus = olBusy .ReminderMinutesBeforeStart = 2880 .ReminderSet = True '.Display 'Save the iCalendar file in a known folder .SaveAs "C:\ApptFiles\OutlookAppointment.ics", olICal 'Use Close to retain the new appointment within the Outlook Calendar, or Delete to delete it. 'Both options keep the just-created .ics file '.Close False .Delete End With Set MItem = OutlookApp.CreateItem(olMailItem) With MItem .To = EmailAddr .Subject = Subj .Body = Msg .Attachments.Add (FileLocation) .Send '.Save 'to Drafts folder End With NotThisOne: End If Next Set OutlookApp = Nothing Set olApt = Nothing Set olApp = Nothing End Sub
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.