我创建了以下代码,该代码会自动通过电子邮件发送工作簿,我希望在发送日期的2天内将发送的电子邮件标记为发件人跟进,以提醒我在2天内跟进发送的电子邮件。
我查看了其他论坛但没有成功,我找到的代码只为收件人设置了标志。
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String
Dim wb As Workbook
Dim FileName As String
Dim wSht As Worksheet
Dim ShtName As String
Dim ws As Worksheet
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & "File Name " & Format(Now, "dd-mm-yy") & ".xlsm"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.createitem(0)
strbody = " Please see the attached spreadsheet.
" & _"Please don't hesitate to contact me if you have any questions.
"
'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Expediting Officer.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.HTMLBody = strbody & "
" & Signature
.display
.Attachments.Add ("File location"\"File Name " & Format(Now, "dd-mm-yy") & ".xlsm")
.display
.Importance = 2
End With
答案 0 :(得分:0)
MailItem类提供以下属性来完成工作:
参见示例代码:
Public Sub FlagMessage(Item As Outlook.MailItem)
With Item
.MarkAsTask olMarkThisWeek
' sets a due date in 48 hours
.TaskDueDate = Now + 2
.ReminderSet = True
.ReminderTime = Now + 2
.Save
End With
End Sub