G
Guest
Hi,
I have been cobbling this script together from posts. I am trying to send a
time-delayed email using .DeferredDeliveryTime that will send a reminder
email one day before a due date on the worksheet, most of the time between
1-3 weeks from the date of sending. Sadly I can not get it to work
I've been trying on and off for a few days now, trying different things.
Right now this is what I have. Any suggestions?
With wb
Dim TempFilePath As String
Dim TempFileName As String
Dim eDueDate as String
TempFileName = SheetName
TempFilePath = Environ$("temp") & "\"
eDueDate = "#" & Format(DateAdd("d", -1, sDueDate3), "mm/dd/yyyy")
& "#"
.Protect ("mypassword") 'PROTECT WORKBOOK
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=lFileFormatNum '(Just gives current unsaved book a
name)
'Send Email
Dim OutlookApp As Object 'Outlook.Application
Dim MailItem As Object 'Outlook.MailItem
Dim Recipient As Object 'Outlook.Recipient
'Dim Attachment As Object 'Outlook.Attachment - does not work this way
Set OutlookApp = CreateObject("Outlook.Application") ' New Outlook
application
'Another example had OutlookApp.Session.Logon
Set MailItem = OutlookApp.CreateItem(olMailItem)
With MailItem ' with the newly created e-mail
Set Recipient = MailItem.Recipients.Add(sEmailAddr) ''this way
allows for error checking
If Not Recipient.Resolve Then ''error checking
MsgBox "There is an invalid recipient"
End If
.DeferredDeliveryTime = eDueDate 'Delays the delivery of the
message
.cc = ""
.BCC = ""
.Subject = "** REMINDER: Your WearTest Style " & sStyle & "
Feedback is Due " & sDueDate2
.Body = "If you have not already done so, please send in your
feedback form."
.Attachments.Add tFF.FullName
On Error Resume Next
.Send 'or .Display
On Error GoTo 0
Set MailItem = Nothing
'Set Attachment = Nothing
Set Recipient = Nothing
Set OutlookApp = Nothing ' clean down memory
Kill TempFilePath & TempFileName & FileExtStr ' delete the
temporary attachment
End With
End With
Any help is truly appreciated.
I have been cobbling this script together from posts. I am trying to send a
time-delayed email using .DeferredDeliveryTime that will send a reminder
email one day before a due date on the worksheet, most of the time between
1-3 weeks from the date of sending. Sadly I can not get it to work
I've been trying on and off for a few days now, trying different things.
Right now this is what I have. Any suggestions?
With wb
Dim TempFilePath As String
Dim TempFileName As String
Dim eDueDate as String
TempFileName = SheetName
TempFilePath = Environ$("temp") & "\"
eDueDate = "#" & Format(DateAdd("d", -1, sDueDate3), "mm/dd/yyyy")
& "#"
.Protect ("mypassword") 'PROTECT WORKBOOK
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=lFileFormatNum '(Just gives current unsaved book a
name)
'Send Email
Dim OutlookApp As Object 'Outlook.Application
Dim MailItem As Object 'Outlook.MailItem
Dim Recipient As Object 'Outlook.Recipient
'Dim Attachment As Object 'Outlook.Attachment - does not work this way
Set OutlookApp = CreateObject("Outlook.Application") ' New Outlook
application
'Another example had OutlookApp.Session.Logon
Set MailItem = OutlookApp.CreateItem(olMailItem)
With MailItem ' with the newly created e-mail
Set Recipient = MailItem.Recipients.Add(sEmailAddr) ''this way
allows for error checking
If Not Recipient.Resolve Then ''error checking
MsgBox "There is an invalid recipient"
End If
.DeferredDeliveryTime = eDueDate 'Delays the delivery of the
message
.cc = ""
.BCC = ""
.Subject = "** REMINDER: Your WearTest Style " & sStyle & "
Feedback is Due " & sDueDate2
.Body = "If you have not already done so, please send in your
feedback form."
.Attachments.Add tFF.FullName
On Error Resume Next
.Send 'or .Display
On Error GoTo 0
Set MailItem = Nothing
'Set Attachment = Nothing
Set Recipient = Nothing
Set OutlookApp = Nothing ' clean down memory
Kill TempFilePath & TempFileName & FileExtStr ' delete the
temporary attachment
End With
End With
Any help is truly appreciated.