KentC
02-04-2012, 08:13 AM
I’m using the following code to send email. It is able to send email and attachment. But, there are glitches:
1. The “To” field is not populating.
2. The “cc’ field is populating with information that is supposed to populate in the “To”
3. The “cc” field is not populating with the “cc” values i.e. a@b.com
Please help.
Sub Mail()
Dim subject As String, text As String, Recipient As String
Dim ccRecipient(35) As Variant
Dim aAttach(35) As Variant
Dim range1 As Range
Dim day, time, ans As String
macro = "Email1.xls"
Recipient = Workbooks(macro).Sheets("abcf"). _
Range("a").Offset(b, 1)
text1 = "Hi ","
text2 = vbNewLine & vbNewLine & "Please find attached..”
text3 = vbNewLine & vbNewLine & vbNewLine & "Regards,"
cc = 1
ccRecipient(cc) = "A@b.com"
cc = 2
ccRecipient(cc) = "d@e.com"
text = text1 & text2 & text3
'MsgBox (subject)
'MsgBox (text)
Call SendOutlookMail(subject, aAttach(), Recipient, ccRecipient(), text, True)
For i = 0 To 39
aAttach(file_count) = Empty
ccRecipient(cc) = Empty
Next i
file_count = 0
cc = 0
f = f + 1
Loop
End Sub
Sub SendOutlookMail(subject As String, attachment As Variant, Recipient As Variant, ccRecipient As Variant, BodyText As String)
'Set up the objects required for Automation into Outlook.
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.attachment
On Error GoTo SendOutlookMail_Err
'Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
'Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
'Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(Recipient)
objOutlookRecip.Type = olTo
'Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(ccRecipient)
objOutlookRecip.Type = olCC
'Set the Subject, Body, and Importance of the message.
.subject = subject
.Body = BodyText & vbCrLf & vbCrLf
'.Importance = olImportanceHigh 'High importance
'Add attachments to the message.
For i = 1 To UBound(attachment)
If Not IsMissing(attachment(i)) Then
Set objOutlookAttach = .Attachments.Add(attachment(i))
End If
Next i
'Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
'Clean Up
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
SendOutlookMail_Err:
Resume Next
End Sub
1. The “To” field is not populating.
2. The “cc’ field is populating with information that is supposed to populate in the “To”
3. The “cc” field is not populating with the “cc” values i.e. a@b.com
Please help.
Sub Mail()
Dim subject As String, text As String, Recipient As String
Dim ccRecipient(35) As Variant
Dim aAttach(35) As Variant
Dim range1 As Range
Dim day, time, ans As String
macro = "Email1.xls"
Recipient = Workbooks(macro).Sheets("abcf"). _
Range("a").Offset(b, 1)
text1 = "Hi ","
text2 = vbNewLine & vbNewLine & "Please find attached..”
text3 = vbNewLine & vbNewLine & vbNewLine & "Regards,"
cc = 1
ccRecipient(cc) = "A@b.com"
cc = 2
ccRecipient(cc) = "d@e.com"
text = text1 & text2 & text3
'MsgBox (subject)
'MsgBox (text)
Call SendOutlookMail(subject, aAttach(), Recipient, ccRecipient(), text, True)
For i = 0 To 39
aAttach(file_count) = Empty
ccRecipient(cc) = Empty
Next i
file_count = 0
cc = 0
f = f + 1
Loop
End Sub
Sub SendOutlookMail(subject As String, attachment As Variant, Recipient As Variant, ccRecipient As Variant, BodyText As String)
'Set up the objects required for Automation into Outlook.
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.attachment
On Error GoTo SendOutlookMail_Err
'Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
'Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
'Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(Recipient)
objOutlookRecip.Type = olTo
'Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(ccRecipient)
objOutlookRecip.Type = olCC
'Set the Subject, Body, and Importance of the message.
.subject = subject
.Body = BodyText & vbCrLf & vbCrLf
'.Importance = olImportanceHigh 'High importance
'Add attachments to the message.
For i = 1 To UBound(attachment)
If Not IsMissing(attachment(i)) Then
Set objOutlookAttach = .Attachments.Add(attachment(i))
End If
Next i
'Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
'Clean Up
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
SendOutlookMail_Err:
Resume Next
End Sub