dcsimg
Results 1 to 4 of 4

Thread: Using a VBA macro in Outlook to export e-mail messages

  1. #1

    Thread Starter
    New Member
    Join Date
    Apr 2019
    Location
    Snow Land: Quebec City, Canada
    Posts
    2

    Using a VBA macro in Outlook to export e-mail messages

    Hi!

    For the past few hours, I tried to find how to export e-mails in .EML format with a macro in Outlook. I currently use this macro:

    Code:
    Sub Extraire_le_message()
    
    Dim DOSSIEROBJET As Outlook.MAPIFolder
    Dim COURRIEL As Outlook.MailItem
    Dim ITEMOBJET As Object
    Dim CHEMINDACCES As String
    Dim xlApp As Object
    Dim fd As Office.FileDialog
    Dim selectedItem As Variant
    Dim DTDATE As Date
    Dim SNOM As String
    Dim DATETEXTE As String
    Dim HEURETEXTE As String
    Dim SECONDESTEXTE As String
    Dim sChr As String
    
    ' Locate the destination.
    
    Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = False
    
    Set fd = xlApp.Application.FileDialog(msoFileDialogFolderPicker)
    
    If fd.Show = -1 Then
        For Each selectedItem In fd.SelectedItems
            Debug.Print selectedItem
        Next
    End If
    
    CHEMINDACCES = fd.SelectedItems(1)
    
    If Right(CHEMINDACCES, 1) <> "\" Then CHEMINDACCES = CHEMINDACCES & "\" ' Pour corriger l'absence de la barre oblique finale si celle-ci devait tre manquante.
    
    ' Export.
    
    For Each ITEMOBJET In ActiveExplorer.Selection
       If ITEMOBJET.MessageClass = "IPM.Note" Then
          Set COURRIEL = ITEMOBJET
        
            SNOM = COURRIEL.Subject
    
            DTDATE = COURRIEL.ReceivedTime
            DATETEXTE = Format(DTDATE, "yyyy-mm-dd", vbUseSystemDayOfWeek, vbUseSystem)
            HEURETEXTE = Mid(Format(DTDATE, "hh:mm:ss", vbUseSystemDayOfWeek, vbUseSystem), 1, 2) & "h" & Mid(Format(DTDATE, "hh:mm", vbUseSystemDayOfWeek, vbUseSystem), 4, 2)
            SECONDESTEXTE = " (" & Right(Format(DTDATE, "hh:mm:ss", vbUseSystemDayOfWeek, vbUseSystem), 2) & ")"
            
            SNOM = DATETEXTE & "_" & HEURETEXTE & "_" & Left(SNOM, 30) & SECONDESTEXTE ' Le fait d'ajouter les secondes  la fin du fichier permet d'viter deux fichiers au mme nom, ce qui pourrait occasionner une erreur d'excution.
            
            Debug.Print CHEMINDACCES & SNOM
            
    sChr = "-"
            
      SNOM = Replace(SNOM, " ", "_")
      SNOM = Replace(SNOM, "'", sChr)
      SNOM = Replace(SNOM, "*", sChr)
      SNOM = Replace(SNOM, "/", sChr)
      SNOM = Replace(SNOM, "\", sChr)
      SNOM = Replace(SNOM, ":", sChr)
      SNOM = Replace(SNOM, "?", sChr)
      SNOM = Replace(SNOM, Chr(34), sChr)
      SNOM = Replace(SNOM, "<", sChr)
      SNOM = Replace(SNOM, ">", sChr)
      SNOM = Replace(SNOM, "|", sChr)
            
      SNOM = Replace(SNOM, "", "a")
      SNOM = Replace(SNOM, "", "a")
      SNOM = Replace(SNOM, "", "a")
      SNOM = Replace(SNOM, "", "a")
      
      SNOM = Replace(SNOM, "", "A")
      SNOM = Replace(SNOM, "", "A")
      SNOM = Replace(SNOM, "", "A")
      SNOM = Replace(SNOM, "", "A")
      
      SNOM = Replace(SNOM, "", "e")
      SNOM = Replace(SNOM, "", "e")
      SNOM = Replace(SNOM, "", "e")
      SNOM = Replace(SNOM, "", "e")
      
      SNOM = Replace(SNOM, "", "E")
      SNOM = Replace(SNOM, "", "E")
      SNOM = Replace(SNOM, "", "E")
      SNOM = Replace(SNOM, "", "E")
      
      SNOM = Replace(SNOM, "", "c")
      
      SNOM = Replace(SNOM, "", "C")
      
      SNOM = Replace(SNOM, "", "i")
      SNOM = Replace(SNOM, "", "i")
      SNOM = Replace(SNOM, "", "i")
      SNOM = Replace(SNOM, "", "i")
      
      SNOM = Replace(SNOM, "", "I")
      SNOM = Replace(SNOM, "", "I")
      SNOM = Replace(SNOM, "", "I")
      SNOM = Replace(SNOM, "", "I")
      
      SNOM = Replace(SNOM, "", "o")
      SNOM = Replace(SNOM, "", "o")
      SNOM = Replace(SNOM, "", "o")
      SNOM = Replace(SNOM, "", "o")
      
      SNOM = Replace(SNOM, "", "O")
      SNOM = Replace(SNOM, "", "O")
      SNOM = Replace(SNOM, "", "O")
      SNOM = Replace(SNOM, "", "O")
      
      SNOM = Replace(SNOM, "", "u")
      SNOM = Replace(SNOM, "", "u")
      SNOM = Replace(SNOM, "", "u")
      SNOM = Replace(SNOM, "", "u")
      
      SNOM = Replace(SNOM, "", "U")
      SNOM = Replace(SNOM, "", "U")
      SNOM = Replace(SNOM, "", "U")
      SNOM = Replace(SNOM, "", "U")
            
      SNOM = Replace(SNOM, " ", "_")
      SNOM = Replace(SNOM, "'", sChr)
      SNOM = Replace(SNOM, "*", sChr)
      SNOM = Replace(SNOM, "/", sChr)
      SNOM = Replace(SNOM, "\", sChr)
      SNOM = Replace(SNOM, ":", sChr)
      SNOM = Replace(SNOM, "?", sChr)
      SNOM = Replace(SNOM, Chr(34), sChr)
      SNOM = Replace(SNOM, "<", sChr)
      SNOM = Replace(SNOM, ">", sChr)
      SNOM = Replace(SNOM, "|", sChr)
            
      SNOM = Replace(SNOM, "__", "_")
      SNOM = Replace(SNOM, "__", "_")
            
            COURRIEL.SaveAs CHEMINDACCES & SNOM & ".msg", olMSG
            COURRIEL.SaveAs CHEMINDACCES & SNOM & ".mht", olMHTML
      End If
    Next
    
    
    End Sub
    It works quite well. All I have to do is to go in Outlook, select a few messages and press the macro button. However, this macro is incomplete for our needs. I also need to export those messages in .EML with the attachment. I guess that all I need is to setup the SaveAs (as I did with olMSG and olMHTML).

    I tried "olMIME" and a few other options without any good results. I also tried:
    Code:
    COURRIEL.SaveAs CHEMINDACCES & SNOM & ".eml"
    Unfortunately, this one didn't work well since I can't see attachments after the files are created.

    Anyone has a clue?

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    24,245

    Re: Using a VBA macro in Outlook to export e-mail messages

    you would have to save it as a message, you can use .eml or .msg, with type olMSG, either will save with the attachments to an external file
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  3. #3

    Thread Starter
    New Member
    Join Date
    Apr 2019
    Location
    Snow Land: Quebec City, Canada
    Posts
    2

    Re: Using a VBA macro in Outlook to export e-mail messages

    Quote Originally Posted by westconn1 View Post
    you would have to save it as a message, you can use .eml or .msg, with type olMSG, either will save with the attachments to an external file
    What's odd with the .EML with olMSG is that I can't see the attachments once when I open the file afterwards. I can see by the file size that the attachment must still be there, but Outlook won't let me see it. What's strange is that I can see the attachment with the .MSG format.

    Any clue on what I do wrong?

  4. #4
    Frenzied Member jdc2000's Avatar
    Join Date
    Oct 2001
    Location
    Idaho Falls, Idaho USA
    Posts
    1,356

    Re: Using a VBA macro in Outlook to export e-mail messages


Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width