Consulting

Results 1 to 6 of 6

Thread: VBA to copy mail with attachments

  1. #1

    VBA to copy mail with attachments

    Am trying to write a script to copy email with certain attachment types.

    New to VBA for outlook, and running into an issue.

    I get an error (Error: (13) Type mismatch) on the line:

    "myATT = Item.Attachments"

    What am I doing incorrectly?

    Public Sub MoveMNS1(Item As Outlook.MailItem)
    On Error GoTo PROC_ERR
        Dim myAtt As Outlook.Attachment
        
         myAtt = Item.Attachments
       
            If Right(LCase(myAtt.FileName), 4) = ".msg" Then
    
                Item.Copy Session.GetDefaultFolder("MNS")
            End If
    PROC_ERR:
      MsgBox "Error: (" & Err.Number & ") " & Err.Description, vbCritical
      Debug.Print "Error: (" & Err.Number & ") " & Err.Description
    End Sub
    Thanks for your help.

  2. #2
    You have defined myAtt as an attachment not a collection of attachments. You need something like the following - see the comment about the folder location and the additional lines of code. The folder location will depend where the folder is located, but "MNS" is not a valid default folder.

    Public Sub MoveMNS1(Item As Outlook.MailItem)
    Dim myAtt As Outlook.Attachment
        On Error GoTo PROC_ERR
        For Each myAtt In Item.Attachments
            If Right(LCase(myAtt.fileName), 4) = ".msg" Then
    '            Item.Copy Session.GetDefaultFolder("MNS") 'This doesn't appear to be a valid folder location
                 ' maybe as follows
                 Item.Copy Session.GetDefaultFolder(olFolderInbox).folders("MNS") 
                Exit For
            End If
        Next myAtt
        Exit Sub
    PROC_ERR:
        MsgBox "Error: (" & Err.Number & ") " & Err.Description, vbCritical
    Debug.Print "Error: (" & Err.Number & ") " & Err.Description
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Thanks gmayor.

    I modified the code as below:

    Public Sub MoveMNS1(Item As Outlook.MailItem)
    On Error GoTo PROC_ERR
        Dim myAtt As Outlook.Attachment
         For Each myAtt In Item.Attachments
         myAtt = Item.Attachments
       
            If Right(LCase(myAtt.FileName), 4) = ".msg" Then
    
                Item.Copy Session.GetDefaultFolder(olFolderInbox).Folders("MNS")
                Exit For
            End If
         Next myAtt
    Set myAtt = Nothing
    PROC_ERR:
      MsgBox "Error: (" & Err.Number & ") " & Err.Description, vbCritical
      Debug.Print "Error: (" & Err.Number & ") " & Err.Description
    End Sub
    I still get the "Error: (13) Type mismatch"

  4. #4
    You have no Exit before the PROC_ERR: so there is always going to be a message box. Remove the On Error line and let's see what the process objects to.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    OK, thanks for sticking with me.

    I added an exit before the PROC_ERR: but still get the Type Mismatch error.

    Public Sub MoveMNS1(Item As Outlook.MailItem)
    On Error GoTo PROC_ERR
        Dim myAtt As Outlook.Attachment
         For Each myAtt In Item.Attachments
         myAtt = Item.Attachments
       
            If Right(LCase(myAtt.FileName), 4) = ".msg" Then
                
                Item.Copy Session.GetDefaultFolder(olFolderInbox).Folders("MNS")
                Exit For
            End If
         Next myAtt
    Set myAtt = Nothing
    GoTo ExitNow
    PROC_ERR:
      MsgBox "Error MNS1: (" & Err.Number & ") " & Err.Description, vbCritical
      Debug.Print "Error MNS1: (" & Err.Number & ") " & Err.Description & " at " & Time & " " & Date
    ExitNow:
    End Sub

  6. #6
    The following works, assuming your folder path is correct
    Public Sub MoveMNS1(Item As Outlook.MailItem)
    'Graham Mayor - https://www.gmayor.com - Last updated - 11 Mar 2020 
    Dim myAtt As Outlook.Attachment
    Dim oCopy As Outlook.MailItem
    
        On Error GoTo PROC_ERR
        If TypeName(Item) = "MailItem" Then
            For Each myAtt In Item.Attachments
                If Right(LCase(myAtt.fileName), 4) = ".msg" Then
                    Set oCopy = Item.Copy
                    oCopy.Move Session.GetDefaultFolder(olFolderInbox).folders("MNS")
                    Exit For
                End If
            Next myAtt
            Set myAtt = Nothing
        End If
        Exit Sub
    PROC_ERR:
        MsgBox "Error MNS1: (" & Err.Number & ") " & Err.Description, vbCritical
    Debug.Print "Error MNS1: (" & Err.Number & ") " & Err.Description & " at " & Time & " " & Date
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

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