Consulting

Results 1 to 17 of 17

Thread: Solved: Simple move email to different folder

  1. #1
    VBAX Contributor
    Joined
    Jul 2009
    Posts
    157
    Location

    Solved: Simple move email to different folder

    I am a VBA newbie to Outlook and barely understand VBA for Excel. I have looked all over for simple code I can edit that will allow me to simply move emails from specific email addresses to a folder in my Personal folders. Sounds easy but I have had no luck figuring it out. I did find Stock code but cannot figure out how to edit it for Outlook. I would have thought there would be a lot of easy samples since it seems this would be something frequently done. I want code to do this rather than using a Rule because we are limited on how many rules we are allowed to use.

    I want to move emails from my default inbox folder (I believe that by using the default Inbox folder as my starting folder I do not have to use the full path) to a folder with the following path (I think)

    The PST file is P:\PST\TestDataFile.pst
    and I believe to get to the actual folder (TestDataFileNAMEfolder) you use this path:
    \TestDataFileNAME\TestDataFileNAMEfolder


    I would like to create code to move email from the email address emailaddress@sample.com to the folder noted above. Eventually I would like it to check for multiple emails and them move them to the correct corresponding folders. I guess I can figure that out possibly once I get the basics down.

    I think the code below is close but I cannot figure out the code to (3) Do soemthing here....
    Any help or advice would be greatly appreciated !


    [VBA]

    Private WithEvents Items As Outlook.Items
    Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")


    ' (1) default Inbox
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
    End Sub
    Private Sub Items_ItemAdd(ByVal item As Object)
    On Error Goto ErrorHandler


    ' (2) only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
    Set Msg = item


    ' (3) do something here --- NEED HELP WITH THIS SECTION



    End If
    ProgramExit:
    Exit Sub
    ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
    End Sub


    [/VBA]

  2. #2
    VBAX Expert JP2112's Avatar
    Joined
    Oct 2008
    Location
    Astoria, NY
    Posts
    590
    Location
    You need to address the folder as it appears in Outlook, and walk the folder hierarchy down to the folder you want to reference. The folders (I assume Outlook 2003 here) are MAPIFolder objects. The MailItem.Move method takes a MAPIFolder object as its parameter.

    For example, if you wanted to move the emails to Inbox\My Messages\My Folder, the code would be

    [VBA]Private WithEvents Items As Outlook.Items
    Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")


    ' (1) default Inbox
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
    End Sub
    Private Sub Items_ItemAdd(ByVal item As Object)
    On Error Goto ErrorHandler


    ' (2) only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    Dim fldr As Outlook.MAPIFolder

    If TypeName(item) = "MailItem" Then
    Set Msg = item


    If Msg.SenderEmailAddress = emailaddress@sample.com Then' edit this part
    Set fldr = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("My Messages").Folders("My Folder")
    Msg.Move fldr
    End If

    End If
    ProgramExit:
    Exit Sub
    ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
    End Sub[/VBA]

    Are you clear on where the code should be placed?
    Regards,
    JP

    Read the FAQ
    Getting free help on the web
    My website
    Please use [vba][/vba] tags when posting code

  3. #3
    VBAX Contributor
    Joined
    Jul 2009
    Posts
    157
    Location
    Thanks JP but I need the folders from a Personal folder PST file and I am not sure how to code it with the following path:

    P:\PST\TestDataFile\TestDataFileNAME\TestDataFileNAMEfolder

    I guess I am not clear on what would change in the code you posted - see below for the specific line I am referring to. For instance would (olFolderInbox) remain the same and if now what would it change to ? I may be able to get there with the following folders once I get started with the intial part of the code.

    [VBA]
    Set fldr = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("My Messages").Folders("My Folder")

    [/VBA]

    Thanks for the help. Any advice on this ?





  4. #4
    VBAX Contributor
    Joined
    Jul 2009
    Posts
    157
    Location
    Oh forgot to mention also that it is Outlook 2007 and the destination folder is not related and is not a subfolder to the Inbox folder which is complicating matters I am afraid :-(

  5. #5
    VBAX Expert JP2112's Avatar
    Joined
    Oct 2008
    Location
    Astoria, NY
    Posts
    590
    Location
    It doesn't matter that it's a personal PST, what matters is that it's open and viewable in the Navigation Pane.

    I can access my default Inbox using

    [VBA]Outlook.Session.GetDefaultFolder(olFolderInbox)[/VBA]

    or

    [VBA]Outlook.Session.Folders("Mailbox - JIMMY PENA").Folders("Inbox")[/VBA]

    I have a local PST file on my computer. The top level is called "Archive Folders" so to access THAT Inbox the code would be

    [VBA]Outlook.Session.Folders("Archive Folders").Folders("Inbox")[/VBA]

    Are you with me so far?

    If the folder was in my local PST, and it was two levels below the Inbox like this:

    Inbox --\
    Level 1 --\
    Level 2

    Then I would reach it like this:

    [VBA]Outlook.Session.Folders("Archive Folders").Folders("Inbox").Folders("Level 1").Folders("Level 2")[/VBA]

    The folder doesn't have to be related to the Inbox. If I had another mail folder that was on the same level as the Inbox, the code would be

    [VBA]Outlook.Session.Folders("Archive Folders").Folders("My Other Mail Folder")[/VBA]

    Now you need to apply that logic to your particular situation.

    One thing you do have to change is in Outlook 2007, the MAPIFolder Object no longer exists. You need to declare MAPIFolder Objects as Folder Objects instead. Otherwise the code should be the same (but always keep the Outlook 2007 Object Model Reference handy.


    Quote Originally Posted by bdsii
    Thanks JP but I need the folders from a Personal folder PST file and I am not sure how to code it with the following path:

    P:\PST\TestDataFile\TestDataFileNAME\TestDataFileNAMEfolder

    I guess I am not clear on what would change in the code you posted - see below for the specific line I am referring to. For instance would (olFolderInbox) remain the same and if now what would it change to ? I may be able to get there with the following folders once I get started with the intial part of the code.

    [vba]
    Set fldr = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("My Messages").Folders("My Folder")

    [/vba]

    Thanks for the help. Any advice on this ?
    Regards,
    JP

    Read the FAQ
    Getting free help on the web
    My website
    Please use [vba][/vba] tags when posting code

  6. #6
    VBAX Contributor
    Joined
    Jul 2009
    Posts
    157
    Location
    Thanks for hanging in there with me on this JP. I used your code and then changed the folders as you advised. I believe I have that part correct. I also used a valid email address to test that already had emails in the Inbox that should be moved to the folder specified. I am not sure which line of code to change as you also advised to declare MAPIFolder Objects as Folder Objects instead. I placed all the code into the ThisOutlookSession area. I thought it may only work on startup so I closed down Outlook and restarted and it did not move the email. I thought it may work upon receipt of the email and tried that with no luck. I then tried creating a Module and putting all the code there and tried those two scenarios and still no luck. Can you review the code below to see if I missed something ? Also, where specifically should the VBA code go into Outlook, into a Module or ThisOutlookSession or a combination ?

    [VBA]

    Private WithEvents Items As Outlook.Items

    Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")


    ' (1) default Inbox
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
    End Sub

    [/VBA]

    and then ....

    [VBA]

    Private Sub Items_ItemAdd(ByVal item As Object)
    On Error GoTo ErrorHandler


    ' (2) only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    Dim fldr As Outlook.MAPIFolder

    If TypeName(item) = "MailItem" Then
    Set Msg = item


    If Msg.SenderEmailAddress = "Myname@somewhere.com" Then
    ' Original example - Set fldr = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("My Messages").Folders("My Folder")

    Set fldr = Outlook.Session.Folders("TestDataFileNAME").Folders("TestDataFileNAMEfolder ")
    ' Actual path - TestDataFile\TestDataFileNAME\TestDataFileNAMEfolder
    Msg.Move fldr
    End If


    End If
    ProgramExit:
    Exit Sub
    ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
    End Sub

    [/VBA]


    I figure I am missing something simple. Does this code run upon startup or does it run upon receipt ? I noticed when I placed the code into a module I could not find it when I hit F8 to run the macro.

    Sorry to bother you but I tried it and tried it and cannot figure this out.

    I did find one piece of code that I got to work once I had your help figuring out the folder issue. That code is below and it proves that the folder settings are correct now.

    [VBA]
    Sub MoveItems_EmailAddress()
    Dim myOlApp As New Outlook.Application
    Dim myNameSpace As Outlook.NameSpace
    Dim myInbox As Outlook.MAPIFolder
    Dim myDestFolder As Outlook.MAPIFolder
    Dim myItems As Outlook.Items
    Dim myItem As Object
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
    Set myItems = myInbox.Items
    ' Set myDestFolder = myInbox.Folders("Personal Mail")
    Set myDestFolder = Outlook.Session.Folders("TestDataFileNAME").Folders("TestDataFileNAMEfolder ")
    Set myItem = myItems.Find("[SenderEmailAddress] = 'Myemail@somewhere.com'")
    While TypeName(myItem) <> "Nothing"
    myItem.Move myDestFolder
    Set myItem = myItems.FindNext
    Wend
    End Sub

    [/VBA]

    So for instructional purposes, are these two pieces of code equivalent ? I have a suspicion that the original code is supposed to run upon receipt or startup whereas the one above runs upon running the macro.

    Thoughts ? I appreciate your help so much :-)

  7. #7
    VBAX Expert JP2112's Avatar
    Joined
    Oct 2008
    Location
    Astoria, NY
    Posts
    590
    Location
    This is event handler code, and should be placed in ThisOutlookSession module. You don't step through it directly, and it doesn't run on startup; it "listens" for the event it is registered for, and fires when that event occurs. In this case, whenever a new item (any item) is added to the folder you specify in the Application_Startup folder.

    The process is --

    1- Outlook starts, Application_Startup is run and the event handler listener is registered;
    2- When a new item (ANY item; anything from an assigned task to an appointment to an email) is added to the folder specified in Application_Startup, the ItemAdd event is executed. This could be when a new item arrives, or if it is dragged and dropped into the folder.
    3- Your code executes.

    Note that you must restart Outlook before the event code will work, and you must restart whenever even the slightest change is made to the code.

    What I do when I'm testing event code is restart Outlook, then open the VB IDE (Alt+F11) and (without making any changes to the code) set a breakpoint on the first line by clicking on the first line (the "ItemAdd" line) and pressing F9. I send an email to myself (or whatever type of object I'm testing for). Then you can step through the code, check the value of variables, and so on. If you have to make changes to the code, restart Outlook and start the process again.

    To change MAPIFolder objects to Folder objects, just change the "As Outlook.MAPIFolder" references to "As Folder". It's as simple as a find and replace (Ctrl+H).

    You're correct about the MoveItems_EmailAddress procedure (although I think it would fail if it ran into a non-MailItem), it's an on demand macro you can run to move items that meet a specific criteria, whereas the code we've been discussing runs automatically (as an event).

    I'm (still) confused about what "P:\PST\TestDataFile\TestDataFileNAME\TestDataFileNAMEfolder" means. Is that a file path, or an Outlook folder path? It just seems odd that an Outlook folder would be called "TestDataFile", but that might be just my hangup.


    Quote Originally Posted by bdsii
    Thanks for hanging in there with me on this JP. I used your code and then changed the folders as you advised. I believe I have that part correct. I also used a valid email address to test that already had emails in the Inbox that should be moved to the folder specified. I am not sure which line of code to change as you also advised to declare MAPIFolder Objects as Folder Objects instead. I placed all the code into the ThisOutlookSession area. I thought it may only work on startup so I closed down Outlook and restarted and it did not move the email. I thought it may work upon receipt of the email and tried that with no luck. I then tried creating a Module and putting all the code there and tried those two scenarios and still no luck. Can you review the code below to see if I missed something ? Also, where specifically should the VBA code go into Outlook, into a Module or ThisOutlookSession or a combination ?

    [vba]

    Private WithEvents Items As Outlook.Items

    Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")


    ' (1) default Inbox
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
    End Sub

    [/vba]
    and then ....

    [vba]

    Private Sub Items_ItemAdd(ByVal item As Object)
    On Error GoTo ErrorHandler


    ' (2) only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    Dim fldr As Outlook.MAPIFolder

    If TypeName(item) = "MailItem" Then
    Set Msg = item


    If Msg.SenderEmailAddress = "Myname@somewhere.com" Then
    ' Original example - Set fldr = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("My Messages").Folders("My Folder")

    Set fldr = Outlook.Session.Folders("TestDataFileNAME").Folders("TestDataFileNAMEfolder ")
    ' Actual path - TestDataFile\TestDataFileNAME\TestDataFileNAMEfolder
    Msg.Move fldr
    End If


    End If
    ProgramExit:
    Exit Sub
    ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
    End Sub

    [/vba]

    I figure I am missing something simple. Does this code run upon startup or does it run upon receipt ? I noticed when I placed the code into a module I could not find it when I hit F8 to run the macro.

    Sorry to bother you but I tried it and tried it and cannot figure this out.

    I did find one piece of code that I got to work once I had your help figuring out the folder issue. That code is below and it proves that the folder settings are correct now.

    [vba]
    Sub MoveItems_EmailAddress()
    Dim myOlApp As New Outlook.Application
    Dim myNameSpace As Outlook.NameSpace
    Dim myInbox As Outlook.MAPIFolder
    Dim myDestFolder As Outlook.MAPIFolder
    Dim myItems As Outlook.Items
    Dim myItem As Object
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
    Set myItems = myInbox.Items
    ' Set myDestFolder = myInbox.Folders("Personal Mail")
    Set myDestFolder = Outlook.Session.Folders("TestDataFileNAME").Folders("TestDataFileNAMEfolder ")
    Set myItem = myItems.Find("[SenderEmailAddress] = 'Myemail@somewhere.com'")
    While TypeName(myItem) <> "Nothing"
    myItem.Move myDestFolder
    Set myItem = myItems.FindNext
    Wend
    End Sub

    [/vba]
    So for instructional purposes, are these two pieces of code equivalent ? I have a suspicion that the original code is supposed to run upon receipt or startup whereas the one above runs upon running the macro.

    Thoughts ? I appreciate your help so much :-)
    Regards,
    JP

    Read the FAQ
    Getting free help on the web
    My website
    Please use [vba][/vba] tags when posting code

  8. #8
    VBAX Contributor
    Joined
    Jul 2009
    Posts
    157
    Location
    Man.....I responded to you JP but it timed out for some reason.



    Anyway the abbreviated version is I used the code and explanation and it worked GREAT !!! thanks so much for your help !!

    I did find out that the code worked if I changed the MAPIFolders to Folders or not and I confirmed I am using Outlook 2007. I thought you would find that interesting.

    Hopefully someone else coming along will find this string to be useful. I am marking it solved now.

    Once again I appreciate it !!

  9. #9
    VBAX Expert JP2112's Avatar
    Joined
    Oct 2008
    Location
    Astoria, NY
    Posts
    590
    Location
    Great job, glad to hear you did it!
    Regards,
    JP

    Read the FAQ
    Getting free help on the web
    My website
    Please use [vba][/vba] tags when posting code

  10. #10
    VBAX Regular
    Joined
    Apr 2016
    Posts
    11
    Location
    Quote Originally Posted by JP2112 View Post
    Great job, glad to hear you did it!
    Hi guys,

    If I want to save/copy all the files from an OutlookFolder to a folder from Desktop, how can I do that?

    I have this code, but because my DestFolderpAth is on "C:\Data\SR_PIXEL_Error_emails" I can;t save this.
    How can I make this code to copy all my emails there?


    For Each oitem In myItems.Restrict("[UnRead] = True")
           oitem.Save (DestFolderPath)
             
         Next

  11. #11
    VBAX Regular
    Joined
    Apr 2016
    Posts
    11
    Location
    Can anyone help please?

  12. #12
    I nearly didn't look at this thread. It is a six year old thread marked as 'solved'. You would have been better served creating a new thread. However

    Option Explicit
    
    Sub SaveMessages()
    Dim olItems As Outlook.Items
    Dim olItem As Outlook.MailItem
    Dim olFolder As Outlook.Folder
    Dim fName As String
    Dim fPath As String
    fPath = "C:\Data\SR_PIXEL_Error_emails\"    'The folder to save the messages
        CreateFolders fPath 'Create the folder if it doesn't exist
        Set olFolder = Session.PickFolder
        Set olItems = olFolder.Items
        For Each olItem In olItems
            If olItem.Sender Like "*@somewhere.com" Then    'Replace with your domain
                fName = Format(olItem.SentOn, "yyyymmdd") & Chr(32) & _
                        Format(olItem.SentOn, "HH.MM") & Chr(32) & olItem.SenderName & " - " & olItem.subject
            Else
                fName = Format(olItem.ReceivedTime, "yyyymmdd") & Chr(32) & _
                        Format(olItem.ReceivedTime, "HH.MM") & Chr(32) & olItem.SenderName & " - " & olItem.subject
            End If
    
            fName = Replace(fName, Chr(58) & Chr(41), "")
            fName = Replace(fName, Chr(58) & Chr(40), "")
            fName = Replace(fName, Chr(34), "-")
            fName = Replace(fName, Chr(42), "-")
            fName = Replace(fName, Chr(47), "-")
            fName = Replace(fName, Chr(58), "-")
            fName = Replace(fName, Chr(60), "-")
            fName = Replace(fName, Chr(62), "-")
            fName = Replace(fName, Chr(63), "-")
            fName = Replace(fName, Chr(124), "-")
            SaveUnique olItem, fPath, fName
        Next olItem
        Set olItem = Nothing
        Set olItems = Nothing
        Set olFolder = Nothing
    lbl_Exit:
        Exit Sub
    End Sub
    
    Private Function CreateFolders(strPath As String)
    'An Office macro by Graham Mayor - www.gmayor.com
    Dim strTempPath As String
    Dim lngPath As Long
    Dim vPath As Variant
    Dim oFSO As Object
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        vPath = Split(strPath, "\")
        strPath = vPath(0) & "\"
        For lngPath = 1 To UBound(vPath)
            strPath = strPath & vPath(lngPath) & "\"
            If Not oFSO.FolderExists(strPath) Then MkDir strPath
        Next lngPath
    lbl_Exit:
        Set oFSO = Nothing
        Exit Function
    End Function
    
    Private Function SaveUnique(oItem As Object, _
                                strPath As String, _
                                strFilename As String)
    'An Outlook macro by Graham Mayor - www.gmayor.com
    Dim lngF As Long
    Dim lngName As Long
    Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        lngF = 1
        lngName = Len(strFilename)
        Do While fso.FileExists(strPath & strFilename & ".msg") = True
            strFilename = Left(strFilename, lngName) & "(" & lngF & ")"
            lngF = lngF + 1
        Loop
        oItem.SaveAs strPath & strFilename & ".msg"
    lbl_Exit:
        Exit Function
    End Function
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  13. #13
    VBAX Regular
    Joined
    Apr 2016
    Posts
    11
    Location
    Hi Graham,

    Thank you for your code.

    How can i customize it to move into my folder from C ==> "C:\Data\SR_PIXEL_Error_emails" all my unread emails from the Outlook folder "2.3.1 ERROR: Pixel Comp - SR " that have the subject==> "Auto Error Notification for PIXEL Component: Service Request"?

    Thank you in advance!

    I really appreciate it,
    Ionut

  14. #14
    VBAX Regular
    Joined
    Apr 2016
    Posts
    11
    Location
    HI Graham,

    I think I solved this. I have this code. Thank you for being there!

    Sub SaveMessages()    Dim olItems As Outlook.Items
        Dim olItem As Outlook.MailItem
        Dim olFolder As Outlook.Folder
        Dim fName As String
        Dim fPath As String
        fPath = "C:\Data\SR_PIXEL_Error_emails\" 'The folder to save the messages
        CreateFolders fPath 'Create the folder if it doesn't exist
        Set olFolder = Session.PickFolder
        Set olItems = olFolder.Items
        For Each olItem In olItems
            If olItem.Subject Like "*Auto Error Notification for PIXEL Component: Service Request" Then
                      SaveUnique olItem, fPath, fName
                      
            End If
            
        Next olItem
        Set olItem = Nothing
        Set olItems = Nothing
        Set olFolder = Nothing
    lbl_Exit:
        Exit Sub
    End Sub
     'An Outlook macro by Graham Mayor - www.gmayor.com
    Private Function CreateFolders(strPath As String)
     
        Dim strTempPath As String
        Dim lngPath As Long
        Dim vPath As Variant
        Dim oFSO As Object
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        vPath = Split(strPath, "\")
        strPath = vPath(0) & "\"
        For lngPath = 1 To UBound(vPath)
            strPath = strPath & vPath(lngPath) & "\"
            If Not oFSO.FolderExists(strPath) Then MkDir strPath
        Next lngPath
    lbl_Exit:
        Set oFSO = Nothing
        Exit Function
    End Function
     'An Outlook macro by Graham Mayor - www.gmayor.com
    Private Function SaveUnique(oItem As Object, _
        strPath As String, _
        strFilename As String)
       
        Dim lngF As Long
        Dim lngName As Long
        Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        lngF = 1
        lngName = Len(strFilename)
        Do While fso.FileExists(strPath & strFilename & ".msg") = True
            strFilename = Left(strFilename, lngName) & "(" & lngF & ")"
            lngF = lngF + 1
        Loop
        oItem.SaveAs strPath & strFilename & ".msg"
    lbl_Exit:
        Exit Function
    End Function

  15. #15
    You haven't quoted your folder structure, but if the named folder "2.3.1 ERROR: Pixel Comp - SR" is a sub folder of your default Inbox then you could use the following, if not use PickFolder instead to select the folder to process. I have added in the unread mail check and the subject check, and given that the subject will now be the same in each message, there is no real need to have the subject in the filename, so I have removed it. Similarly as you will only be checking a named folder the sent mail folder option has also been removed.

    Sub SaveMessages()
    Dim olItems As Outlook.Items
    Dim olItem As Outlook.MailItem
    Dim olFolder As Outlook.Folder
    Dim fName As String
    Dim fPath As String
    fPath = "C:\Data\SR_PIXEL_Error_emails\"    'The folder to save the messages
    CreateFolders fPath    'Create the folder if it doesn't exist
        'Set olFolder = Session.PickFolder
        Set olFolder = Session.GetDefaultFolder(olFolderInbox).folders("2.3.1 ERROR: Pixel Comp - SR")
        Set olItems = olFolder.Items
        For Each olItem In olItems
            If olItem.UnRead = True Then
                If olItem.subject = "Auto Error Notification for PIXEL Component: Service Request" Then
                    fName = Format(olItem.ReceivedTime, "yyyymmdd") & Chr(32) & _
                            Format(olItem.ReceivedTime, "HH.MM") & Chr(32) & olItem.SenderName ' & " - " & olItem.subject
                    fName = Replace(fName, Chr(58) & Chr(41), "")
                    fName = Replace(fName, Chr(58) & Chr(40), "")
                    fName = Replace(fName, Chr(34), "-")
                    fName = Replace(fName, Chr(42), "-")
                    fName = Replace(fName, Chr(47), "-")
                    fName = Replace(fName, Chr(58), "-")
                    fName = Replace(fName, Chr(60), "-")
                    fName = Replace(fName, Chr(62), "-")
                    fName = Replace(fName, Chr(63), "-")
                    fName = Replace(fName, Chr(124), "-")
                    SaveUnique olItem, fPath, fName
                End If
            End If
        Next olItem
        Set olItem = Nothing
        Set olItems = Nothing
        Set olFolder = Nothing
    lbl_Exit:
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  16. #16
    VBAX Regular
    Joined
    Apr 2016
    Posts
    11
    Location
    Hi Graham,

    I got an error at the lines Createfolders fPath and SaveUnique olItem. the error is Compile error Sub or Function not defined.

  17. #17
    VBAX Regular
    Joined
    Apr 2016
    Posts
    11
    Location
    Man,

    I got it! nothing else to do! Thank you very much!

Posting Permissions

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