-
If you would like to post, please check out the MrExcel Message Board FAQ and register here. If you forgot your password, you can reset your password.
Help Required on VBA Program for sending different Excel File to Different Recipients.........
- Thread starter brsindhe
- Start date
Dim lastrow As Integer
Sub Mail_Workbook()
Dim oupApp As Object
Dim outMail As Object
Dim emailID As String
Dim CC As String
Dim BCC As String
Dim body1 As String
Dim body2 As String
Dim body3 As String
Dim body4 As String
Dim body5 As String
Dim body6 As String
Dim firstName As String
Dim fs As FileSearch
Dim subject As String
Dim i As Integer
Dim bodyContent As Range
Dim Attachments As String
'Set OutApp = CreateObject("Outlook.Application")
'Set outMail = OutApp.CreateItem(0)
ThisWorkbook.Worksheets("Email ID").Activate
Call last_Find_Row
For i = 2 To lastrow
Set outapp = CreateObject("Outlook.Application")
Set outMail = outapp.CreateItem(0)
ThisWorkbook.Worksheets("Control").Activate
ThisWorkbook.Worksheets("Email ID").Activate
subject = ActiveSheet.Cells(i, 6).Value
emailID = ActiveSheet.Cells(i, 1).Value
CC = ActiveSheet.Cells(i, 2).Value
BCC = ActiveSheet.Cells(i, 3).Value
firstName = ActiveSheet.Cells(i, 4).Value
ThisWorkbook.Worksheets("Email ID").Activate
If Attachments = subject Then
.Addattachments "C:\Users\praveen.sindhe\Desktop\FY14 CIS V2 & .xlsx"
ThisWorkbook.Worksheets("Body of the Letter").Activate
body1 = ActiveSheet.Range("A2").Value & " " & firstName
body2 = ActiveSheet.Range("A4").Value & " "
Strbody = body1 & "<br>" & _
body2 & "<br>"
StrBody2 = ActiveSheet.Range("A12").Value & "<br>" & _
ActiveSheet.Range("A15").Value & "<br>" & _
ActiveSheet.Range("A16").Value
If CC = "" And BCC = "" Then
With outMail
.To = emailID
.subject = subject
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & body1 & "<br>" & " " & "<br>" & body2 & "<br>" & " " & "<br>" & StrBody2
.Display
End With
ElseIf CC = "" And BCC <> "" Then
With outMail
.To = emailID
.BCC = BCC
.subject = subject
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & body1 & "<br>" & " " & "<br>" & body2 & "<br>" & " " & "<br>" & StrBody2
.Display
End With
ElseIf CC <> "" And BCC = "" Then
With outMail
.To = emailID
.CC = CC
.subject = subject
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & body1 & "<br>" & " " & "<br>" & body2 & "<br>" & " " & "<br>" & StrBody2
.Display
End With
Else
With outMail
.To = emailID
.CC = CC
.BCC = BCC
.subject = subject
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & body1 & "<br>" & " " & "<br>" & body2 & "<br>" & " " & "<br>" & StrBody2
.Display
End With
End If
Next i
Set outMail = Nothing
Set outapp = Nothing
MsgBox "Mail Sending ---->(IN-PROGRESS)<-----. Please Check Your Out Box Mails.......
"
End Sub
Sub last_Find_Row()
lastrow = ThisWorkbook.Worksheets("Email ID").Range("A:A").Find("*", SearchOrder:=xlByRows, _
LookIn:=xlValues, SearchDirection:=xlPrevious).Row
End Sub
Sub Save_Close()
ThisWorkbook.Close True
End Sub
Sub Mail_Workbook()
Dim oupApp As Object
Dim outMail As Object
Dim emailID As String
Dim CC As String
Dim BCC As String
Dim body1 As String
Dim body2 As String
Dim body3 As String
Dim body4 As String
Dim body5 As String
Dim body6 As String
Dim firstName As String
Dim fs As FileSearch
Dim subject As String
Dim i As Integer
Dim bodyContent As Range
Dim Attachments As String
'Set OutApp = CreateObject("Outlook.Application")
'Set outMail = OutApp.CreateItem(0)
ThisWorkbook.Worksheets("Email ID").Activate
Call last_Find_Row
For i = 2 To lastrow
Set outapp = CreateObject("Outlook.Application")
Set outMail = outapp.CreateItem(0)
ThisWorkbook.Worksheets("Control").Activate
ThisWorkbook.Worksheets("Email ID").Activate
subject = ActiveSheet.Cells(i, 6).Value
emailID = ActiveSheet.Cells(i, 1).Value
CC = ActiveSheet.Cells(i, 2).Value
BCC = ActiveSheet.Cells(i, 3).Value
firstName = ActiveSheet.Cells(i, 4).Value
ThisWorkbook.Worksheets("Email ID").Activate
If Attachments = subject Then
.Addattachments "C:\Users\praveen.sindhe\Desktop\FY14 CIS V2 & .xlsx"
ThisWorkbook.Worksheets("Body of the Letter").Activate
body1 = ActiveSheet.Range("A2").Value & " " & firstName
body2 = ActiveSheet.Range("A4").Value & " "
Strbody = body1 & "<br>" & _
body2 & "<br>"
StrBody2 = ActiveSheet.Range("A12").Value & "<br>" & _
ActiveSheet.Range("A15").Value & "<br>" & _
ActiveSheet.Range("A16").Value
If CC = "" And BCC = "" Then
With outMail
.To = emailID
.subject = subject
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & body1 & "<br>" & " " & "<br>" & body2 & "<br>" & " " & "<br>" & StrBody2
.Display
End With
ElseIf CC = "" And BCC <> "" Then
With outMail
.To = emailID
.BCC = BCC
.subject = subject
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & body1 & "<br>" & " " & "<br>" & body2 & "<br>" & " " & "<br>" & StrBody2
.Display
End With
ElseIf CC <> "" And BCC = "" Then
With outMail
.To = emailID
.CC = CC
.subject = subject
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & body1 & "<br>" & " " & "<br>" & body2 & "<br>" & " " & "<br>" & StrBody2
.Display
End With
Else
With outMail
.To = emailID
.CC = CC
.BCC = BCC
.subject = subject
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & body1 & "<br>" & " " & "<br>" & body2 & "<br>" & " " & "<br>" & StrBody2
.Display
End With
End If
Next i
Set outMail = Nothing
Set outapp = Nothing
MsgBox "Mail Sending ---->(IN-PROGRESS)<-----. Please Check Your Out Box Mails.......
"End Sub
Sub last_Find_Row()
lastrow = ThisWorkbook.Worksheets("Email ID").Range("A:A").Find("*", SearchOrder:=xlByRows, _
LookIn:=xlValues, SearchDirection:=xlPrevious).Row
End Sub
Sub Save_Close()
ThisWorkbook.Close True
End Sub
Upvote
0
Similar threads
- Solved
