Sending emails from Excels with attachements!

[nandhamnk]

Hi,

I need help in VB code in excel which i made for sending emails from excel.

Given below the code which i already made

Let me brief what i need.

I created VB code with a help of my friend for sending the invoices thru email from excelwith six attachements to attach the files.

Now i created a folder which contains pdf files need to be picked from the attachemtns while sending mail from Excel

For Ex,
Iam having invoice.pdf file,its in the folder Invoice.If i give the link of attachment in the excel sheet,it needs to pick the PDF file in the [color=blue! important][color=blue! important]email [color=blue! important]attachment[/color][/color][/color] ( Folder may contain many files too )

Hope somebody can help me

Thanks in advance

 

[nandhamnk]

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

 

[nandhamnk]

:d

 

[nandhamnk]

Anyone can help me out

 

[nandhamnk]