Nhờ anh chị giúp đỡ VBA : code auto save khi nhận mail mới

nguyennpa

Yêu THVBA
Chào anh chị
Mình có xin một đoạn code tự động lưu khi có mail mới nhờ các anh chị thêm giúp em phần :sender , ngày , sub , receiver code , nhưng em thêm vào không chay được . Cám ơn
(StrFile = StrSaveFolder & "e-from_" & StrSenderName & "_" & StrReceived & "_re_" & StrName & ".msg"
ElseIf LCase(StrFolderName) = "sent items" Then
StrFile = StrSaveFolder & "e-to_" & StrTo & "_" & StrReceived & "_re_" & StrName & ".msg")


Private WithEvents InboxItems As Outlook.Items

Sub Application_Startup()

Dim xNameSpace As Outlook.NameSpace

Set xNameSpace = Outlook.Application.Session

Set InboxItems = xNameSpace.GetDefaultFolder(olFolderInbox).Items

End Sub


Private Sub InboxItems_ItemAdd(ByVal objItem As Object)

Dim FSO

Dim xMailItem As Outlook.MailItem

Dim xFilePath As String

Dim xRegEx

Dim xFileName As String

On Error Resume Next

xFilePath = CreateObject("WScript.Shell").SpecialFolders(16)

xFilePath = xFilePath & "\MyEmails"

Set FSO = CreateObject("Scripting.FileSystemObject")

If FSO.FolderExists(xFilePath) = False Then

FSO.CreateFolder (xFilePath)

End If

Set xRegEx = CreateObject("vbscript.regexp")

xRegEx.Global = True

xRegEx.IgnoreCase = False

xRegEx.Pattern = "\||\/|\<|\>|""|:|\*|\\|\?"

If objItem.Class = olMail Then

Set xMailItem = objItem

xFileName = xRegEx.Replace(xMailItem.Subject, "")

xMailItem.SaveAs xFilePath & "\" & xFileName & ".msg", olMSG

End If

Exit Sub

End Sub
 

tuhocvba

Administrator
Thành viên BQT
1. Bạn nên để code trong thẻ CODE.
2. Theo tôi biết Outlook đã có chức năng lưu mail trên ổ đĩa máy tính. Nên tôi không biết bạn lưu từng cái mail thành file .msg làm gì.
 
Top