• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Outlook email to local drive

Monty

Well-Known Member
Hello Team.

Is there any way to get all emails from different generic email box to copy to our local drive in different folders as .msg using Excel VBA..

Thanks
 
If by generic email box you mean an Outlook folder, the answer is yes.

If you want a specific example, what is the criterion for the Outlook folder(s) and the associated local folder(s) to save the mailitem file(s) to?
 
Hello keeneth

Yes I meen a specific folder .....and looking for to save all emails in local drive with .msg

When we copy manually all mails from inbox to local drive it appears as.msg filea ...the same way looking out with excel vba
 
For the inbox Outlook folder, this should work. Change the value of sF to match your local folder name.
Code:
Sub SaveEmails()
  Dim ns As Namespace
  Dim Inbox As MAPIFolder
  Dim Item As outlook.MailItem
  Dim sF As String
  
  sF = "c:\temp\msg\"
  
  Set ns = GetNamespace("MAPI")
  Set Inbox = ns.GetDefaultFolder(olFolderInbox)

  ' Check Inbox for messages and exit if none found
  If Inbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
           "Nothing Found"
    Exit Sub
  End If
  
  ' Save inbox items as MSG files to sF
  For Each Item In Inbox.Items
    If TypeName(Item) <> "MailItem" Then GoTo NextItem
    Item.SaveAs sF & Replace(Replace(Item.ReceivedTime, "/", "-"), ":", ".") & ".msg", olMSG 'olmsgunicode
    'Debug.Print Replace(Replace(Item.ReceivedTime, "/", "-"), ":", ".")
NextItem:
  Next Item
End Sub

To use more custom Outlook folder objects, there are two or more methods that one can consider:
1. Use the current folder.
2. Use more code to hardcode the object that I can share. It does require that you know the email address of the active Outlook session.
 
Wonderful....

One last request ...How we go about specific folder only...

Currently the macro is picking the mail's not from latest email received in the box but...getting email from backward..

Please help
 
When the example that I made last night for you syncs up with my work computers, I will post it.

I don't see how but if order of saving matters, one can use a counter method to iterate forward or backward.
 
If you need the counter iteration method, let me know.

Change the value for sInbox for "Car" to your Outlook folder name and the email address to yours as well. If that does not work, I can show you how to get the Outlook active folder's path in various ways.

Code:
Sub SaveEmails2()
  Dim ns As Namespace
  Dim Inbox As MAPIFolder
  Dim Item As outlook.MailItem
  Dim sF As String, sInbox As String
 
  sF = "c:\temp\msg\"
  sInbox = "\\ken@gmail.com\Car"
 
  Set ns = GetNamespace("MAPI")
  'Set Inbox = ns.GetDefaultFolder(olFolderInbox)
  Set Inbox = GetFolderPath(sInbox, outlook.Application)
  'Debug.Print Inbox.Name 'Car

  ' Check Inbox for messages and exit if none found
  If Inbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
           "Nothing Found"
    Exit Sub
  End If
 
  ' Save inbox items as MSG files to sF
  For Each Item In Inbox.Items
    If TypeName(Item) <> "MailItem" Then GoTo NextItem
    Item.SaveAs sF & Replace(Replace(Item.ReceivedTime, "/", "-"), ":", ".") & ".msg", olMSG 'olmsgunicode
NextItem:
  Next Item
 
  MsgBox "Macro has finished."
End Sub

Code:
'Similar to, http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/#GetFolderPath
''Early Binding: Tools > References > Microsoft Outlook xx.0 Object Library > OK
Function GetFolderPath(ByVal FolderPath As String, oApp As outlook.Application) As outlook.Folder
    Dim oFolder As outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer
    
    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
   FoldersArray = Split(FolderPath, "\")
    'Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
   Set oFolder = oApp.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As outlook.Folders
            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.Item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
        Next
    End If
    'Return the oFolder
   Set GetFolderPath = oFolder
    Exit Function
    
GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function
End Function
 
Back
Top