I use Outlook 2010 and i try from Visuas Basic script not VBA to add Bcc Recipient
My code is the following. Send email to Recipient but not to Bcc.
Do you know anyone the solution. Note that from VBA is working properly.
Sub sendcomment_click()
Set oMsg = Application.CreateItem(olMailItem)
With oMsg
.Recipients.Add("email address")
Set objRecip= Item.Recipients.Add("email address")
objRecip.Type = olBCC
objRecip.Resolve
.Subject = "New Comment by"
.Body = "sdfsdfsdf"
.Send
End With
end sub
Assuming you have the email addresses for BCC already, you could just add email address without resolving it.
Unless you want to resolve it first then get the email address off it, then you need more code. By the way, you should define Const olBCC = 3 outside this sub.
Sub sendcomment_click()
Set oMsg = Application.CreateItem(olMailItem)
With oMsg
.Recipients.Add ("email address")
'Set objRecip = Item.Recipients.Add("email address")
'objRecip.Type = olBCC
'objRecip.Resolve
' Join Email addresses by "; " into ".BCC" as string
.BCC = "Person.A#somewhere.com; Person.B#somewhere.com"
.Subject = "New Comment by"
.Body = "sdfsdfsdf"
.Display ' Comment this to have it not show up
'.Send ' Uncomment this to have it sent automatically
End With
Set oMsg = Nothing
End Sub
Code executed screenshot:
Related
I am reading senduser emails with Redemption library and trying to send the email through SMTP CDO.Object.
I have been receiving following error, as long as I get the email for "EX" senderEmailType through Mail.Sender.SMTPAddress: CDO.Message.1: The transport lost its connection to the server.
Here is my code snippet (will lead to an error as long as mailReceiver argument is taken through Mail.Sender.SMTPAddress Redemption property - even converted to string it leads to the same error - cStr(Mail.Sender.SMTPAddress)) Although when I change the mailReceiver Property to the same email as string - it does not generate any error like this (maiLReceiver = "xx#like.com"):
sub sendMailSMTP(mailSubject, mailSender, mailReceiver, CC, BCC, replyTo, HTMLBody, attachmentsPath_List, REMOTE_SMTP, SMTP, PORT_SMTP, SCHEMAS)
HTML_CID = ""
set CDOObject = CreateObject("CDO.Message")
with CDOObject
.subject = mailSubject
.from = mailSender
.to = mailReceiver
.CC = CC
.BCC = BCC
.replyTo = replyTo
.HTMLBody = HTMLBody & HTML_CID
.TextBodyPart.Charset = "utf-8"
.AddAttachment LOGO_MAIL
.Attachments(1).Fields.Item("urn:schemas:mailheader:content-disposition") ="attachment;filename="& replace(split(LOGO_MAIL, "\")(ubound(split(LOGO_MAIL, "\"))),".jpg","")
.Attachments(1).Fields.Update
for each attachmentPath in attachmentsPath_List
.AddAttachment attachmentPath
next
end with
with CDOObject.Configuration.Fields
.Item(SCHEMAS & "sendusing") = REMOTE_SMTP
.Item(SCHEMAS & "smtpserver") = SMTP
.Item(SCHEMAS & "smtpserverport") = PORT_SMTP
.Item(SCHEMAS & "smtpconnectiontimeout") = 60
.Update
end with
CDOObject.Send
set CDOObject = Nothing
end sub
Could anyone point me to the right direction, what may be the reason for that?
I am developing a script to send an email according to certain inputs, I am able to craft the email but not send it using the .Send method.
I am getting the following error: (please note that the line is matching the .Send use in the original case)
I have already successfully sent emails using the .SendKeys(^~) method, but I would like to be use Outlook object to do so and not simply send shortcuts.
This is my current code:
' Declare all variables that will be used later on
Dim outobj, mailobj, emailto, cc, subject, body, attachement
Dim strFileText
Dim objFileToRead
Dim splitEmailto
' Set the outlook application object
Set outobj = CreateObject("Outlook.Application")
' set the namespace
Set myNamespace = outobj.GetNameSpace("MAPI")
msgbox myNamespace.Folders(2)
' Set the mail item object
Set mailobj = outobj.CreateItem(olMailItem)
' Set a shell
Set WshShell = WScript.CreateObject("WScript.shell")
' Get all the argument and assign
emailto = "name#domain.eu"
cc = "name#domain.eu"
subject = "Simple Email"
body = "Some Text"
attachement = "C:\Users\name\Desktop\fileName.xls"
' Craft the email object
With mailobj
.Display
' assign the tos
.To = cstr(emailto)
' add CCs
.CC = cstr(cc)
' attach the relevant files
If attachement <> "" Then
If instr(attachement, ";") Then
splitAtt = split(attachement, ";")
For Each att In splitAtt
If att <> "" Then
.Attachments.add cstr(att)
End If
Next
Else
.Attachments.add cstr(attachement)
End If
End If
If Subject <> "" Then
.Subject = Subject ' sets the subject
End If
If body <> "" Then
.Body = body ' sets the body
End If
.Send
End With
' Clear the memory
Set outobj = Nothing
Set mailobj = Nothing
' check for no more events in the sending event
' Report out & Quits
WScript.StdOut.WriteLine("Email sent")
WScript.Quit
I would like to be able to send the email with the .Send. any idea?
The error is E_ABORT.
Why are you displaying the message and immediately calling Send? You either display the message (Display, but no Send), or just send it outwith displaying (Send, but no Display).
When resolve all cannot process (due to multiple users on our system with the same first/last name) the macro fails to run. Is there a way to get outlook to display the names and let me select which john doe I want (if not then maybe just remove the names it can't resolve).
Sub Reply_All_From_Folder()
Dim original As MailItem
Dim reply As MailItem
Set original = ActiveInspector.CurrentItem.ReplyAll
Set reply = Application.CreateItem(olMailItem)
With reply
.SentOnBehalfOfName = "folder#work.com"
.Subject = original.Subject
.To = Replace(original.To, "emailoRemove#test.com", "")
.CC = original.CC
.HTMLBody = original.HTMLBody
.Recipients.ResolveAll
.Display
End With
End Sub
You can simulate pressing the Check Names button if ResolveAll is false.
Sub Reply_All_From_Folder_NotResolveAll()
Dim trueoriginal As mailItem
Dim original As mailItem
Dim reply As mailItem
Set trueoriginal = ActiveInspector.currentItem
Set original = ActiveInspector.currentItem.ReplyAll
Set reply = CreateItem(olMailItem)
With reply
.subject = original.subject
.To = original.To & "; notaresolvablename" & "; smith, john"
If Not .Recipients.ResolveAll Then
.Display
ActiveInspector.CommandBars.ExecuteMso ("CheckNames")
Else
.Send
End If
End With
trueoriginal.Close olDiscard
ExitRoutine:
Set trueoriginal = Nothing
Set original = Nothing
Set reply = Nothing
End Sub
My Outlook Address book by default storing e-mail addresses in the combination of upper and lower case letters, in that case below code is not working for me. Please advise.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim Recipients As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim i
Dim prompt As String
On Error Resume Next
' use lower case for the address
' LCase converts all addresses in the To field to lower case
Checklist = "firstname.lastname#domain.com"
Set Recipients = Item.Recipients
For i = Recipients.Count To 1 Step -1
Set recip = Recipients.Item(i)
If InStr(LCase(recip), LCase(Checklist)) Then
prompt$ = "You sending this to this messgae to Treasurer " & Item.To & ". Are you sure you want to send it?"
If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
End If
End If
Next i
End Sub
How can I send an email to a group of recipients with CDO? I'm using VB6.
You can list multiple recipients on the .To line by separating them with ";", for example:
Set m = Server.CreateObject("CDO.Message")
m.Subject="subject..."
m.From="sender#example.com"
m.To="some#email.com;other#email.com;third#email.com"
m.TextBody="Message"
m.Send
This works in Office 97 and whatever Exchange we had back then:
Dim oOApp As Outlook.Application
Dim newMail As Outlook.MailItem
Set oOApp = CreateObject("Outlook.Application")
Set newMail = oOApp.CreateItem(olMailItem)
With newMail
.Display
.Body = whatever
.Subject = whatever
.Attachments.Add whatever
.Recipients.Add (whomever)
.Send
End With
Set newMail = Nothing
Set oOApp = Nothing