Consulting

Results 1 to 3 of 3

Thread: Save all messages in outlook folder to local folder

  1. #1

    Save all messages in outlook folder to local folder

    So my goal is to select a folder and then run a macro which will go through every item in the selected folder and save each email to a local folder on my hard drive. I've cobbled together the code below, however I can't get it to run correctly. Whenever I run the macro the first message gets saved as itshould and then my outlook freezes and crashes or it will give me a run-timeerror '-2147287037 (80030003)': Operation failed. If I instead select all messages in the folder and just run the SaveMessageAsMsg () function, it works pretty well except that a few emails are getting skipped. For example I justselected 175 items in the outlook folder, ran SaveMessageAsMsg and only 172were saved. I made sure and checked the message class of all the items in thefolder and they are all "IPM.Note" as specified in the code.

    I'm hoping you all will be able to help me with (1) helpingme understand the "BackupEmail" portion of my code is causing outlookto crash or return an error, and (2) help me understand why only 172 out of 175messages are saving when I just run the SaveMessageAsMsg function. And if thereis no fix is there a way to use a MsgBox to tell me exactly which emails needto be manually saved?

  2. #2
    [CODE] Public Sub BackupEmails()
    Dim objOL As Outlook.Application
    Dim objItems As Outlook.Items
    Dim objFolder As Outlook.MAPIFolder
    Dim obj As Object

    Set objOL = Outlook.Application
    Set objFolder = objOL.ActiveExplorer.CurrentFolder
    Set objItems = objFolder.Items

    For Each obj In objItems
    With obj
    Call SaveMessageAsMsg
    End With
    Next

    Set obj = Nothing
    Set objItems = Nothing
    Set objFolder = Nothing
    Set objOL = Nothing
    MsgBox "All attachments have been extracted"

    End Sub
    Public Sub SaveMessageAsMsg()
    Dim oMail As Outlook.MailItem
    Dim objItem As Object
    Dim sPath As String
    Dim dtDate As Date
    Dim sName As String
    Rem Dim enviro As String
    Dim strFolderpath As String

    strFolderpath = "C:\Test\"
    Rem enviro = CStr(Environ("USERPROFILE"))
    For Each objItem In ActiveExplorer.Selection
    If objItem.MessageClass = "IPM.Note" Then
    Set oMail = objItem

    sName = oMail.Subject
    sName = Left(sName, 100)
    ReplaceCharsForFileName sName, "-"

    dtDate = oMail.ReceivedTime
    sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
    vbUseSystem) & Format(dtDate, "-hhnnss", _
    vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

    sPath = strFolderpath
    Debug.Print sPath & sName
    oMail.SaveAs sPath & sName

    End If
    Next

    End Sub

  3. #3


    I also have a function to replace the illegal characters inthe file name but for some reason I'm not allowed to post that portion of thecode because of too many URLs or something?

Posting Permissions

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