Results 1 to 20 of 40

Thread: Outlook macro to save emails in a specific folder based on a msgbox popup

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Newbie
    Joined
    Apr 2016
    Posts
    4
    Location

    Outlook macro to save emails in a specific folder based on a msgbox popup

    Hi All,

    I found a macro online which I’m trying to use to save the email to a folder within a specified directory. The folders are numbers either 4 or 5 digits like 5100 for example.

    The macro isn’t finding the destination folder, even when I’ve changed it to c:\test and created a folder etc and tried different network directories.

    Any ideas?

    Private Function File_Exists(ByVal sPathName As String, Optional Directory As Boolean) As Boolean
        ' Returns True if the passed sPathName exist Otherwise returns False
        On Error Resume Next
        If sPathName <> "" Then
            If IsMissing(Directory) Or Directory = False Then
                File_Exists = (Dir$(sPathName) <> "")
            Else
                File_Exists = (Dir$(sPathName, vbDirectory) <> "")
            End If
        End If
    End Function
     
    Sub SaveAsMSG()
        Dim myItem As Outlook.Inspector
        Dim objItem As Object
        PathName = "\\myserver\folder\"
        Set myOlApp = CreateObject("Outlook.Application")
        Set myItem = myOlApp.ActiveInspector
        If Not TypeName(myItem) = "Nothing" Then
            Set objItem = myItem.CurrentItem
            StrSub = objItem.Subject
            StrName = InputBox("Folder number...")
            Do While File_Exists(PathName & StrName & "\Emails\", True) = False
                StrName = InputBox("Folder does not exist, give a new number...", "new folder number")
            Loop
            Do While File_Exists(PathName & StrName & "\Emails\" & StrSub & ".msg") = True
                StrSub = InputBox("File exists, give a new file name...", "new file name", StrSub)
            Loop
            objItem.SaveAs PathName & StrName & "\Emails\" & StrSub & ".msg", olMSG
        Else
            MsgBox "There is no current opened email item."
        End If
    End Sub
    Last edited by Aussiebear; 01-07-2025 at 03:34 PM.

Tags for this Thread

Posting Permissions

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