Macro to add the zip file as an attachemnt

[Balajisx]

I am looking for a macro to add the zip folder from the file and add the into outlook mail.
before that I have to copy a specific range from a different workbook and have to paste it in the body of the email .then I want to add a zipped folder as an attachement. I tried with below code but it is not working. please help me
Sub Sending_Mails()

ActiveWorkbook.Sheets("Summary").Select
Set pt = ActiveSheet.PivotTables("Summary")

Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Selection.Columns.AutoFit

Set rng = Nothing
On Error Resume Next

Set rng = Selection.SpecialCells(xlCellTypeVisible)

Set rng = Sheets("sheet1").Range("A1:K14").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

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

trbody = "Dear Team," & "<br>" & "<br>" & _
"Please find the Summary based on the updated system data and the updated Manifest file.Attached is the Compare sheet for your review." & "<BR>" & "<BR>"

Signature = Chr(10) & Chr(10) & Chr(10) & "Thanks & Regards" & Chr(10) & Chr(10) & Chr(10) & "<BR>" & "<BR>" & "Balaji"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "balaji.suriyanarayanan@outlook.com"
.BCC = ""
.Subject = "Request For System Data"
.HTMLBody = strbody & RangetoHTML(rng) & Signature
.Attachments.Add = "C:\Users\Balaji\Desktop\Automation\comparesheet.zip"
.Send
End With

MsgBox ("Mail sent successfully"), vbOKOnly
Application.DisplayAlerts = False
ActiveWorkbook.Close
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing


End Sub

 

[PCosta87]

Hi,

I'm sorry for not going through your code but since I already worked on the following for another user, perhaps you can make use of it:

Sub Send_Email()

    Dim c As Range
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object

    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells
        Set OutLookApp = CreateObject("Outlook.application")
        Set OutLookMailItem = OutLookApp.CreateItem(0)
        With OutLookMailItem
                .To = c.Value
                .CC = c.Offset(, 1).Value
                .Subject = c.Offset(, 2).Value
                .HTMLBody = c.Offset(, 3).Value
                .Attachments.Add c.Offset(, 4).Value
                .Display
    '            .Send
        End With
    Next c

End Sub

The structure of the file it is based on is as follows:


Hope this helps

 

[Monty]

Hello Pocasta

Good piece of shot code .