Excel VBA to Attach File And Automatically Send Email

[Excel Fox]

Here's a code to open msg files from a folder, and send it to a mail id

Sub SendMSGFiles()

    Dim objItemMSG As Object
    Dim strFolderLocation As String
    Dim objFolder As Object
    Dim strFile As String
    Dim olApp As Object
    
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    Err.Clear: On Error GoTo 0: On Error GoTo -1
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    Set objFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Select MSG folder location", 0, "")
    If Not objFolder Is Nothing Then
        strFolderLocation = objFolder.self.Path
    Else
        Exit Sub
    End If
    strFile = Dir(strFolderLocation & "\*.msg")
    While strFile <> ""
        Set objItemMSG = olApp.CreateItemFromTemplate(strFolderLocation & "\" & strFile)
        objItemMSG.To = "abc@xyz.com"
        objItemMSG.Send
        strFile = Dir
    Wend
    
End Sub

[snb]

Simply use sendmail....

[malay]

Hi,

Thank you very much for the support. I could not able to forward the mail but succeed to read the content and paste in another mail and then send to the mail id. I manage to find this code from Ms office help but can't execute it successfully, showing an error message "Run time error 438 Object doesn't support this property or method" at line "Set myinspector = Application.ActiveInspector" in MS office 2007. Please help me to solve this problem and I think my purpose will be solved manipulating the below formula.

Thanks.

Sub RemoveAttachmentBeforeForwarding()
    Dim myinspector As Outlook.Inspector
    Dim myItem As Outlook.MailItem
    Dim myattachments As Outlook.Attachments

    Set myinspector = Application.ActiveInspector
    If Not TypeName(myinspector) = "Nothing" Then
        Set myItem = myinspector.CurrentItem.Forward
        Set myattachments = myItem.Attachments
        While myattachments.Count > 0
            myattachments.Remove 1
        Wend
        myItem.Display
        myItem.Recipients.Add "Dan Wilson"
        myItem.Send
    Else
        MsgBox "There is no active inspector."
    End If
End Sub

[Friel300]

I got ExcelFox's to work bang on.

if your files are in a standard location you could change the

    Set objFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Select MSG folder location", 0, "")
    If Not objFolder Is Nothing Then
        strFolderLocation = objFolder.self.Path

to

         strFolderLocation ="c:\YOUR LOCATION"

[Excel Fox]

malay, the code you've posted is to remove attachments from the mail. Your question though was regarding opening msg files from a folder, and forwarding it as it is. Am I mistaken?

[malay]

Sorry for late response. Yes, the code attached is to remove attachments but in fact i need item attached to the mail. I just gave you the example from the Ms office help on how to forward mail. Can you do me a favor by writing the complete code to open and forward saved mails with attachments as discussed earlier because i am confused how to write as you found a solution that i cannot understand.

[malay]

Hi.

The code you provided can open the ".msg" file in forward mode but "From.." option in outlook is showing the person's name from whom the mail has been originally received. This is why the mail cannot be forwarded clicking the send button. Please tell me how to change the original "From.." to the current sender's mail id...

Sub SendMSGFiles()

    Dim objItemMSG As Object
    Dim strFolderLocation As String
    Dim objFolder As Object
    Dim strFile As String
    Dim olApp As Object
    
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    Err.Clear: On Error GoTo 0: On Error GoTo -1
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    Set objFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Select MSG folder location", 0, "")
    If Not objFolder Is Nothing Then
        strFolderLocation = objFolder.self.Path
    Else
        Exit Sub
    End If
    strFile = Dir(strFolderLocation & "\*.msg")
    While strFile <> ""
        Set objItemMSG = olApp.CreateItemFromTemplate(strFolderLocation & "\" & strFile)
        objItemMSG.To = "abc@xyz.com"
        objItemMSG.Send
        strFile = Dir
    Wend
    
End Sub

[Excel Fox]

malay, there is a clear instruction on top of the quick reply box to use code tags for any code used in the post. Please adhere to forum rules and guidelines.

So you want to make the mail as if you were sending the mail, instead of it look like a forward mail?