Hi,
I need help in customizing Outlook with attaching files.
Let me brief what i need.
I customized with a help of my friend sending the invoices thru email.
I need to attach PDF files in every attachments.
Anyone can help me out in this
Thanks
Sub SendEmail()
Dim OutlookApp As Object
Dim MItem As Object
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim August As String
Dim Msg, Filename1, Filename2, Filename3, Filename4, Filename5, Filename6 As String
Dim ccName As String
'Create Outlook object
Set OutlookApp = CreateObject("Outlook.Application")
'Loop through the rows
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "*@*" Then
'Get the data
Subj = "Billing Details for the Month of July'07"
Recipient = cell.Offset(0, -1).Value
EmailAddr = cell.Value
ccName = cell.Offset(0, 3).Value
Filename1 = cell.Offset(0, 4).Value
Filename2 = cell.Offset(0, 5).Value
Filename3 = cell.Offset(0, 6).Value
Filename4 = cell.Offset(0, 7).Value
Filename5 = cell.Offset(0, 8).Value
Filename6 = cell.Offset(0, 9).Value
August = Format(cell.Offset(0, 1).Value, "$0,000.")
'Compose message
Msg = "Hi " & Recipient & vbCrLf & vbCrLf
Msg = Msg & " Please find attached the invoices "
Msg = Msg & ""
Msg = Msg & August & vbCrLf & vbCrLf
Msg = Msg & "Thanks" & vbCrLf
Msg = Msg & "Sign"
'Create Mail Item and send it
Set MItem = OutlookApp.CreateItem(0)
With MItem
.To = EmailAddr
.cc = ccName
.Subject = Subj
.Body = Msg
If Trim(Filename1) <> "" Then
.attachments.Add Filename1
End If
If Trim(Filename2) <> "" Then
.attachments.Add Filename2
End If
If Trim(Filename3) <> "" Then
.attachments.Add Filename3
End If
If Trim(Filename4) <> "" Then
.attachments.Add Filename4
End If
If Trim(Filename5) <> "" Then
.attachments.Add Filename5
End If
If Trim(Filename6) <> "" Then
.attachments.Add Filename6
End If
.Display
End With
End If
Next
End Sub
Bookmarks