kumar shanmugam
New Member
- Outlook version
- Outlook 365 64 bit
- Email Account
- Office 365 Exchange
Currently below vba code auto download email into a specific folder in local hard disk as and when any new email arrives in Inbox
I want to do modifications in below code so that it only auto downloads email into a specific folder saved in local hard disk as and when any email moved to inbox/subfolder. i am maintaining approval records in excel file and i want to link those records with corresponding approval. msg saved in hard drive folders for better tracking and reference purpose. I don't know where to change the code to get the desired output. please help.
Public Sub SaveMsg(Item As Outlook.MailItem)
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
sName = Item.Subject
ReplaceCharsForFileName sName, "_"
dtDate = Item.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"
' use My Documents in older Windows.
sPath = enviro & "\Documents\ApprovalMails\"
Debug.Print sPath & sName
Item.SaveAs sPath & sName, olMSG
End Sub
Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub
Sub aagdsa()
End Sub
I want to do modifications in below code so that it only auto downloads email into a specific folder saved in local hard disk as and when any email moved to inbox/subfolder. i am maintaining approval records in excel file and i want to link those records with corresponding approval. msg saved in hard drive folders for better tracking and reference purpose. I don't know where to change the code to get the desired output. please help.
Public Sub SaveMsg(Item As Outlook.MailItem)
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
sName = Item.Subject
ReplaceCharsForFileName sName, "_"
dtDate = Item.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"
' use My Documents in older Windows.
sPath = enviro & "\Documents\ApprovalMails\"
Debug.Print sPath & sName
Item.SaveAs sPath & sName, olMSG
End Sub
Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub
Sub aagdsa()
End Sub