• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

MACRO to send custom excel file via Outlook (with custom body)

G

gaurav99

New Member
Hi Everyone - I am trying to record a macro to send an excel file via outlook mail with custom data. Please suggest..

Many thanks in advance !!

(attached file for reference)

Mail body comprises of data present in excel file (data present in column N to Q - data is dynamic and is subject to change)

Mail subject: Counts of Name-- (ID:--) - Date:

Mail body :
Hi -
ABC (ID: ) did__100__ count on date
Thanks
 

Attachments

  • MACRO.xlsx
    18.9 KB · Views: 5
Hi Gaurav,

You can use something like the below.

Make sure you update the email id's and the subject accordingly. You could also find additional information here.

http://www.rondebruin.nl/win/s1/outlook/mail.htm

Code: 
Sub Mail_Single_SendRequest()
'Working in 2000-2010
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim r As Integer, x As Double
     
    For r = 12 To 12 'data in row 12
    Dim strbody As String
    With Application
    
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    Set wb1 = ActiveWorkbook

    If Val(Application.Version) >= 12 Then
        If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
                   "be no VBA code in the file you send. Save the" & vbNewLine & _
                   "file first as xlsm and then try the macro again.", vbInformation
            Exit Sub
        End If
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Make a copy of the file/Open it/Mail it/Delete it
    'If you want to change the file name then change only TempFileName
    TempFilePath = Environ$("temp") & "\"
    TempFileName = wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    FileExtStr = "." & LCase(Right(wb1.Name, _
                                   Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
     
    strbody = "Dear " & "[name]," _
    & Chr(10) & Chr(10) & "[email subject]." _
    & Chr(10) & Chr(10) & "Best Regards," _
    & Chr(10) & Chr(10) & "[name]"          
     
       ' Change the mail address and subject in the macro before
       ' running the procedure.
       'get the email address
    
    OutMail = Cells(r, 5)
       
    With OutMail
    .To = "[email id]"
    .CC = "[email id]"
    .BCC = ""
    .Subject = "[enter your subject]"
    .Body = strbody & .Body
    .Attachments.Add wb2.FullName
    'You can add other files also like this
    '.Attachments.Add ("C:\test.txt")
    .display   'or use .Display
    End With
    On Error GoTo 0

    wb2.Close SaveChanges:=False

    'Delete the file
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With
    Next r
    End Sub

Kind regards,
Anand
 
Thanks a lot Anand. This is on the lines I want. But can i request following changes to suggested solution.

1. File saving: I am planning to add the code to a read only template which would be 'saved as' particular name (as mentioned in cell M2, this is generated based on certain inputs) at a particular location (say desktop)

2. Mail body and Subject: I want to keep the mail body and subject dynamic by incorporating data in Row#1 of columns P to Column S

sample subject: Data for ABC (column P): ID: (column R): Dated (column Q)

Sample body: Hi All,

Mr. ABC did *********************** on Column Q
Desired: blah
Actual: Column S

3. And lastly: deleting everything except from data present in A:K range

Thanks a lot in advance and for your patience to read the above :)
 

Attachments

  • Template.xlsm
    27.2 KB · Views: 9
Hey Anand - I was able to make the required changes. (code attached). Can you please guide to following last steps:

1. Change the temp file format to 'xlsx'. tried modifying the string function but getting error

2. Deleting Columns K to Column R from temp file.

3. removing the data in row 12 condition

many thanks

Code: 
Sub Mail_Single_SendRequest()
'Working in 2000-2010
  Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim r As Integer, x As Double
   
    For r = 12 To 12 'data in row 12
  Dim strbody As String
    With Application
   
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    Set wb1 = ActiveWorkbook

    If Val(Application.Version) >= 12 Then
        If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
                  "be no VBA code in the file you send. Save the" & vbNewLine & _
                  "file first as xlsm and then try the macro again.", vbInformation
            Exit Sub
        End If
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Make a copy of the file/Open it/Mail it/Delete it
  'If you want to change the file name then change only TempFileName
  TempFilePath = Environ$("temp") & "\"
    TempFileName = ActiveWorkbook.Sheets("Details").Range("M2").Value
    FileExtStr = "." & LCase(Right(wb1.Name, _
                                  Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
   
    strbody = "Hi " & "," _
    & Chr(10) & Chr(10) & ActiveWorkbook.Sheets("Details").Range("P1") & " - " & _
    ActiveWorkbook.Sheets("Details").Range("N2") & " - " & " " & _
    ActiveWorkbook.Sheets("Details").Range("N1") & "." _
    & Chr(10) & Chr(10) & "" _
    & Chr(10) & Chr(10) & "s " & "" & Format(ActiveWorkbook.Sheets("Details").Range("S1"), "Percent") _
    & Chr(10) & Chr(10) & "Best Regards," _
    & Chr(10) & Chr(10) & "[name]"
   
      ' Change the mail address and subject in the macro before
      ' running the procedure.
      'get the email address
 
    OutMail = Cells(r, 5)
     
    With OutMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = "Work " & " - " & ActiveWorkbook.Sheets("Details").Range("P1").Value & _
    " - " & ActiveWorkbook.Sheets("Details").Range("N2").Value & " - " & _
    ActiveWorkbook.Sheets("Details").Range("N1").Value
    .Body = strbody & .Body
    .Attachments.Add wb2.FullName
    'You can add other files also like this
  '.Attachments.Add ("C:\test.txt")
  .display  'or use .Display
  End With
    On Error GoTo 0

    wb2.Close SaveChanges:=False

    'Delete the file
  Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With
    Next r
    End Sub
 
You must log in or register to reply here.
Back
Top