ReminderTime = Now + 2 ' sets reminder to 2 days after saving email
DueDate = Now + 3 ' sets due date to 3 days after saving email I'm not able to fully test your macro because it's complicated and I don't have some of the files, but this is the stripped version of your macro - it creates a message then a task - the hyperlink insertion can either before or after you display it. objSel.Range, strLink, "", "", strLinkText, "" ' objSel.Range, strPath & strMsgSubj, "", "", strPath & strMsgSubj, ""įor Each objMail In ObjTask.ReminderTime = Now + 2 ' sets reminder to 2 days after saving email ObjTask.DueDate = Now + 3 ' sets due date to 3 days after saving email Set objTask = Application.CreateItem(olTaskItem) ' create new task if option to do is selected. Please review the message link above and action as appropriate. "Received: " & Format(nton, "yyyy-mm-dd Hh.Nn.Ss") & "" & "Email location: " & "" & strPath & " " & "" & "Link to message: " & "" & strPath & strMsgSubj & " " & "" & _ Msg.HTMLBody = "" & "From: " & nder & "" & "Subject: " & msgItem.Subject & "" & _ Signature = CreateObject("Scripting.FileSystemObject").GetFile(Signature).OpenAsTextStream(1, -2).ReadAll Signature = Signature & Dir$(Signature & "*.htm") If Dir(Signature, vbDirectory) vbNullString Then Signature = Environ("appdata") & "\Microsoft\Signatures\" Msg.Subject = "*** A Saved Email Requires Your Attention ***" Set msg = Application.CreateItem(olMailItem) ' create notification email if option to do is selected.
'Save new msg file to defined filename and location ' cleans illegal characters from strMsgSubj. StrMsgSubj = Format(nton, "yyyy-mm-dd Hh.Nn.Ss") & " " & "" & " " & strMsgSubj & ".msg"Įlse 'single email using name given in textbox8 StrMsgSubj = Format(nton, "yyyy-mm-dd Hh.Nn.Ss") & " " & "" & " " & & "_0" & lngCounter & ".msg"ĮlseIf blnMulti = True Then 'multiple emails being saved using the default name If = True Then 'multiple emails being saved using a user specified name MsgItemTo = arrMsgTo(0) & " et al" ' uses the first recipient where there is multiple recipients ' Set msgitem.to to the first recipient if multiple recipients in to fieldĪrrcount = UBound(arrMsgTo) - LBound(arrMsgTo) + 1 ' Set objSel = objDoc.Windows(1).Selection ' Added by Alan McGowan 20-11-15 ' Set objDoc = objInsp.WordEditor ' Added by Alan McGowan 20-11-15 ' Set objInsp = objTask.GetInspector ' Added by Alan McGowan 20-11-15 ' Dim objSel As Word.Selection ' Added by Alan McGowan 17-11-15 ' Dim objDoc As Word.document ' Added by Alan McGowan 17-11-15 ' Dim objInsp As Inspector ' Added by Alan McGowan 17-11-15 Sub MsgSaver(strPath As String, msgItem As Outlook.MailItem, lngCounter As Long, blnMulti As Boolean)ĭim arrMsgTo() As String ' Added by Alan McGowan 6-11-15ĭim msgItemTo As String ' Added by Alan McGowan 6-11-15ĭim arrcount As Long ' Added by Alan McGowan 6-11-15ĭim msglink As String ' Added by Alan McGowan 17-11-15ĭim msg As Outlook.MailItem ' Added by Alan McGowan 17-11-15ĭim objTask As Outlook.TaskItem ' Added by Alan McGowan 20-11-15ĭim Signature As String ' Added by Alan McGowan 17-11-15
0 kommentar(er)
