locked
Macro to Forward Multiple Emails as attachments RRS feed

  • Question

  • I have a macro which I had working on a PC, but just did a fresh install of Windows and Office 2010.

    Now the macro doesnt want to run, producing an error.

     

    Sub SpamAssassin()
        
        Dim ns As NameSpace
        Set ns = Application.GetNamespace("MAPI")
        Set objJunk = ns.GetDefaultFolder(olFolderJunk).Items
        
        'Assign the email address to forward items to
        Dim msgAssassin As String
        msgAssassin = assp-spam@blank.com
    
        
        Dim objMail As Object
        Dim objNewMail As Object
        
        'Assign variable to delete items
        Dim i As Long
        Dim objJunkFolder As Outlook.Folder
        Dim objJunkMail As Outlook.Items
        Set objJunkFolder = ns.GetDefaultFolder(olFolderJunk)
        Set objJunkMail = objJunkFolder.Items
        
        Set objNewMail = Application.CreateItem(olMailItem)
    
        
        'Forward each item as attachment
        For Each objMail In objJunk
        objNewMail.Attachments.Add objMail
        Next
    
        
        'Delete item from Junk E-mail Folder
        For i = objJunkMail.Count To 1 Step -1
        objJunkMail.Remove i
        Next
    
        objNewMail.To = msgAssassin
        objNewMail.Subject = "Reporting Items"
        objNewMail.Display
    
        
    Set objJunk = Nothing
    Set objMail = Nothing
    Set objNewMail = Nothing
    
    End Sub

     

    I am getting the error at the Loop

        'Forward each item as attachment
        For Each objMail In objJunk
        objNewMail.Attachments.Add objMail  :: Run-time error '-2117221233(8004010f)': The attempted operation failed. An Object could not be found.
        Next

     

    Any advice and assistance would be greatly appreciated.

     Thanks

    Craig


    • Edited by CraigF1 Wednesday, November 9, 2011 4:10 AM
    Wednesday, November 9, 2011 4:08 AM

Answers

  • Hello,

    The macro below works fine for me. That is, I've added the declaration for objJunk and corrected the value assigned to msgAssassin.

    Sub SpamAssassin()
        Dim objJunk As Items
        Dim ns As NameSpace
        Set ns = Application.GetNamespace("MAPI")
        Set objJunk = ns.GetDefaultFolder(olFolderJunk).Items
        
        'Assign the email address to forward items to
        Dim msgAssassin As String
        msgAssassin = "assp-spam@blank.com"
         
        Dim objMail As Object
        Dim objNewMail As Object
        
        'Assign variable to delete items
        Dim i As Long
        Dim objJunkFolder As Outlook.Folder
        Dim objJunkMail As Outlook.Items
        Set objJunkFolder = ns.GetDefaultFolder(olFolderJunk)
        Set objJunkMail = objJunkFolder.Items
        
        Set objNewMail = Application.CreateItem(olMailItem)
         
        'Forward each item as attachment
        For Each objMail In objJunk
            objNewMail.Attachments.Add objMail
        Next
         
        'Delete item from Junk E-mail Folder
        For i = objJunkMail.Count To 1 Step -1
            objJunkMail.Remove i
        Next
    
        objNewMail.To = msgAssassin
        objNewMail.Subject = "Reporting Items"
        objNewMail.Display
    
        
    Set objJunk = Nothing
    Set objMail = Nothing
    Set objNewMail = Nothing
    
    End Sub
    


    Regards from Belarus (GMT + 2),

    Andrei Smolin
    Add-in Express Team Leader
    • Marked as answer by CraigF1 Wednesday, November 9, 2011 1:06 PM
    Wednesday, November 9, 2011 5:52 AM

All replies

  • Hello,

    The macro below works fine for me. That is, I've added the declaration for objJunk and corrected the value assigned to msgAssassin.

    Sub SpamAssassin()
        Dim objJunk As Items
        Dim ns As NameSpace
        Set ns = Application.GetNamespace("MAPI")
        Set objJunk = ns.GetDefaultFolder(olFolderJunk).Items
        
        'Assign the email address to forward items to
        Dim msgAssassin As String
        msgAssassin = "assp-spam@blank.com"
         
        Dim objMail As Object
        Dim objNewMail As Object
        
        'Assign variable to delete items
        Dim i As Long
        Dim objJunkFolder As Outlook.Folder
        Dim objJunkMail As Outlook.Items
        Set objJunkFolder = ns.GetDefaultFolder(olFolderJunk)
        Set objJunkMail = objJunkFolder.Items
        
        Set objNewMail = Application.CreateItem(olMailItem)
         
        'Forward each item as attachment
        For Each objMail In objJunk
            objNewMail.Attachments.Add objMail
        Next
         
        'Delete item from Junk E-mail Folder
        For i = objJunkMail.Count To 1 Step -1
            objJunkMail.Remove i
        Next
    
        objNewMail.To = msgAssassin
        objNewMail.Subject = "Reporting Items"
        objNewMail.Display
    
        
    Set objJunk = Nothing
    Set objMail = Nothing
    Set objNewMail = Nothing
    
    End Sub
    


    Regards from Belarus (GMT + 2),

    Andrei Smolin
    Add-in Express Team Leader
    • Marked as answer by CraigF1 Wednesday, November 9, 2011 1:06 PM
    Wednesday, November 9, 2011 5:52 AM
  • Thankyou very much.

    I got up this morning and ran the macro, before making the changes and it worked.  odd.

    Anyway, i added the new line (Dim objJunk As Items) as i guess thats what was giving me the error to start with.  The quotes around the email address was just a paste error.

    Thanks for your quick response. Very much appreciated.

    Regards

    Craig


    • Edited by CraigF1 Wednesday, November 9, 2011 1:13 PM
    Wednesday, November 9, 2011 1:12 PM
  • i tried the above code as i need in a same need, but i get a syntax error at the END SUB line. i am a new bee to this

    please help with this.

    Sub ATSBI()
        Dim ATSBImails As Items
        Dim ns As NameSpace
        Set ns = Application.GetNamespace("MAPI")
        Set ATSBImails = ns.GetDefaultFolder(Voice).Items
        
        'Assign the email address to forward items to
        Dim ATSBIRecipient As String
        ATSBIRecipient = "xxxxx@yyyy.com"
         
        Dim objMail As Object
        Dim objNewMail As Object
        
        'Assign variable to delete items
        Dim i As Long
        Dim objFolder As Outlook.Folder
        Dim obMail As Outlook.Items
        Set obFolder = ns.GetDefaultFolder(Voice)
        Set obMail = obFolder.Items
        
        Set objNewMail = Application.CreateItem(olMailItem)
         
        'Forward each item as attachment
        For Each objMail In ATSBImails
            objNewMail.Attachments.Add objMail
        Next
         
        'Delete item from Junk E-mail Folder
        For i = obMail.Count To 1 Step -1
            obMail.Remove i
        Next
    
        objNewMail.To = ATSBIRecipient
        objNewMail.Subject = "Reporting Items"
        objNewMail.Display
    
        
    Set objJunk = Nothing
    Set objMail = Nothing
    Set objNewMail = Nothing
    
    End Sub

    Thursday, February 8, 2018 12:53 PM
  • i have also changed

    Set objJunk = Nothing

    to

    Set ATSBImails= Nothing

    Thursday, February 8, 2018 2:22 PM