Consulting

Results 1 to 2 of 2

Thread: Saving Emails from specific sender to folder on hard drive

  1. #1
    VBAX Newbie
    Joined
    Dec 2019
    Posts
    3
    Location

    Saving Emails from specific sender to folder on hard drive

    Hello all and many thanks for past help. Reaching out once because I am trying to create an Excel spreadsheet where I can add a button to launch a macro that will allow a way to save all the emails in the inbox from a specific sender - this is a shared mailbox- to a folder on a shared hard drive (P:\responses) I would like to create a subfolder with the current date and have the emails saved there. Access to creating and running macros is disabled within Outlook, but we can use them in Excel. Any assistance would be most appreciated in tackling this. Thanks again in advance!!

  2. #2
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    Hi holley,

    You can give the below a try:
    Sub SaveMSGs()    
        Dim olFolder As Folder
        Dim olItem As MailItem
        Dim iCount As Integer
        Dim aPath As String, sPath As String
        Dim fdObj As Object
    
        aPath = "C:\Users\jbloggs\Desktop\test\" '<<< Change to suit
        sPath = apth & Replace(Date, "/", ".") & "\"
    
        Set fdObj = CreateObject("Scripting.FileSystemObject")
        If Not fdObj.FolderExists(sPath) Then
            fdObj.CreateFolder (sPath)
        End If
    
        Set olFolder = Session.PickFolder
        For iCount = 1 To olFolder.Items.Count
            Set olItem = olFolder.Items(iCount)
            If olItem.Class = OlObjectClass.olMail Then
                olItem.SaveAs sPath & ValidName(olItem.Subject) & ".msg"
            End If
        Next iCount
    
        Set olItem = Nothing
        Set olFolder = Nothing
    
        MsgBox "Complete"
    End Sub
    
    
    Private Function ValidName(Arg As String) As String
        Dim RegEx As Object
        Set RegEx = CreateObject("VBScript.RegExp")
        With RegEx
            .Pattern = "[\\/:\*\?""<>\|]"
            .Global = True
            ValidName = .Replace(Arg, "")
        End With
    End Function
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

Posting Permissions

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