Consulting

Results 1 to 4 of 4

Thread: Please help me Edit code with : Send , Date , Sub , Receiver in code below . Thanks

  1. #1

    Please help me Edit code with : Send , Date , Sub , Receiver in code below . Thanks

    Dear All .
    Please help me add : Send , Date , Sub , Receiver in code below . Thanks
    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






    Last edited by nguyennpa; 04-02-2021 at 09:05 AM.

  2. #2
    It is not clear what you are trying to do, but see http://www.vbaexpress.com/forum/show...plied-messages
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Dear.
    Please help me add this code in code below: If LCase(StrFolderName) = "inbox" Then
    StrFile = StrSaveFolder & "e-from_" & StrSenderName & "_" & StrReceived & "_re_" & StrName & ".msg"
    ElseIf LCase(StrFolderName) = "sent items" Then
    StrFile = StrSaveFolder & "e-to_" & StrTo & "_" & StrReceived & "_re_" & StrName & ".msg"

    - I want file backup the same : e-from_Timy A_20211103_0514pm_re_FW Test Mail

    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

  4. #4
    Did you look at the code in the link? It does almost what you require and can do exactly what you require with only minor changes.
    Your code was aimed at messages going into the inbox. If you want it to work for sent items, you are going to have to setup a second event related to the sent items folder.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •