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?
Related
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
I have a legacy VB6 codebase which I would like to extend to include support for sending mails through an external SMTP server (smtp.live.com).
I use CDO for sending the mail. My machine runs Windows 7.
Unfortunately I get a "The transport failed to connect to the server" error message when trying to send send the mail.
Below is the code.
VB6
Dim oNewMessage As CDO.Message
Dim iConf As New CDO.Configuration
Dim oFlds As ADODB.Fields
Dim strbody As String
On Error GoTo errSMPT
iConf.Load cdoDefaults
Set oFlds = iConf.Fields
oFlds(cdoSendUsingMethod) = cdoSendUsingPort
oFlds(cdoSMTPServer) = "smtp.live.com"
oFlds(cdoSMTPServerPort) = 587
oFlds(cdoSMTPConnectionTimeout) = 30
oFlds(cdoSMTPUseSSL) = True
oFlds(cdoSMTPAuthenticate) = cdoBasic
oFlds(cdoSendUserName) = "xxxxxx#hotmail.com"
oFlds(cdoSendPassword) = "mypassword"
oFlds.Update
strbody = "Sample message " & Time
Set oNewMessage = New CDO.Message
Set oNewMessage.Configuration = iConf
With oNewMessage
.To = txtTo.Text
.From = txtFrom.Text
.Subject = "subject"
.TextBody = strbody
.Send
End With
Exit Sub
errSMPT:
MsgBox Err.Description
I don't think that the problem is related to firewall or account security issues since the C# code below works without any problems.
C#
using (MailMessage message = new MailMessage(txtFrom.Text, txtTo.Text, txtSubject.Text, txtText.Text))
{
SmtpClient mailClient = new SmtpClient("smtp.live.com", 587);
mailClient.Credentials = new System.Net.NetworkCredential("xxxxxx#hotmail.com", "mypassword");
mailClient.EnableSsl = true;
mailClient.Send(message);
MessageBox.Show("Message successfully sent!!!");
}
Any help is appreciated!
Thanks
//Peter
I think your problem is here:
oFlds(cdoSMTPUseSSL) = True
This should be an integer instead of a boolean. When VB6 converts true to and int, the value is -1. I suggest you change that line to:
oFlds(cdoSMTPUseSSL) = 1
set cdoConfig = CreateObject("CDO.Configuration")
with cdoConfig.Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "localhost"
.Item(cdoSMTPAuthenticate) = 1
.Item(cdoSendUsername) = "contact#example.com"
.Item(cdoSendPassword) = "password"
.Update
end with
set cdoMessage = CreateObject("CDO.Message")
with cdomessage
set .Configuration = cdoConfig
.From = "contact#example.com"
.To = email
.Subject = subject
.HTMLBody = message
.AddAttachment "c:/i/report.pdf"
.Send
end with
set cdomessage = nothing
set cdoconfig = nothing
Everything sends find, but the recipient gets the message as "Untitled Attachment 000X.pdf"
How do I give the attachment a name?
I have something like this. But never tried.
'With cdomessage
.AddAttachment "c:/i/report.pdf"
.Attachments(1).Fields.Item("urn:schemas:mailheader:content-disposition") ="attachment;filename=" & NEWNAME
.Attachments(1).Fields.Update
'End With
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:
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