MAPI Control Multiple attachments - vb6

I am trying to send an email with multiple attachments using the VB6 MAPIMessages control.
1) I am able to use this control to send a single attachment but it displays an error saying "Attachment not found", if I try to send more than one file.
2) I also need to suppress the warning message when I try to send an email
Any ideas?
Here's the code:
MAPISession1.SignOn
MAPIMessages1.SessionID = MAPISession1.SessionID
MAPIMessages1.Compose
MAPIMessages1.RecipDisplayName = "abbid_siddiqui#hotmail.com"
MAPIMessages1.MsgSubject = "MAPI subject with attachments"
MAPIMessages1.MsgNoteText = "This is atest"
MAPIMessages1.AttachmentIndex = 0
MAPIMessages1.AttachmentName = "test.csv"
MAPIMessages1.AttachmentPathName = "C:\test.csv"
MAPIMessages1.AttachmentIndex = 1
MAPIMessages1.AttachmentName = "holidays_2013.xls"
MAPIMessages1.AttachmentPathName = "E:\holidays_2013.xls"
MAPIMessages1.ResolveName
'Send the e-mail message to the Recipient
MAPIMessages1.Send

Try setting the AttachmentPosition property to the same value as the AttachmentIndex

Related

address error when send email with 32bit outlook using automation

NOTE: edited from original after I discovered the outlook version was 32-bit not 64-bit.
I have a legacy 32-bit VB6 program that uses outlook 2010 32bit (full version, not express) to send email. Works perfect on many machines except one machine with windows 7 (64-bit I assume). Not sure if all windows 7 machines don't work or just this one.
If I use the automation technique or the MAPI technique (as I call them, see code below) outlook sends the email but the mail server kicks it back as undeliverable saying the recipient does not exist.
Now if the automation technique is used outlook displays no UI and the email is sent in the background.
However if the MAPI technique is used outlook opens it's compose email dialog which allows the user to edit the email prior to sending. What is interesting is that the recipient email looks fine but will fail as undeliverable if sent. However if the recipient is deleted and re-typed then the email will succeed. I believe a copy and re-paste works also.
This tells me there must be one or more hidden illegal characters in the recipient email address (nulls perhaps?). The code to do this shown below is very plain and I can't think of any obvious fix. txtTo is a vb6 string with an email address and this is the field that is causing all the problems.
The error message:
Your message did not reach some or all of the intended recipients.
Subject: a test from daryls cpu #2
Sent: 11/17/2017 8:01 PM
The following recipient(s) cannot be reached:
'someemail#gmail.com' on 11/17/2017 8:01 PM
None of your e-mail accounts could send to this recipient.
Automation Technique
Dim mOutlookApp As Object
Set mOutlookApp = GetObject("", "Outlook.application")
Dim olNs As Object
Set olNs = mOutlookApp.GetNamespace("MAPI")
olNs.Logon
Dim OutMail As Object
Set OutMail = mOutlookApp.CreateItem(0)
'Set the To and Subject lines. Send the message.
With OutMail
.To = txtTo
.CC = txtCC
.Subject = txtSubjext
.HTMLBody = txtBody & vbCrLf
Dim myAttachments As Object
Set myAttachments = .Attachments
vAttach = Split(mAttachments, ",")
For i = 0 To UBound(vAttach)
myAttachments.add vAttach(i)
Next i
Dim myFolder As Object
Set myFolder = olNs.GetDefaultFolder(5) 'olFolderSent
Set .SaveSentMessageFolder = myFolder
StatusBar1.Panels(1).Text = "Status: Sending"
.send
End With
MAPI Technique
'Open up a MAPI session:
With frmMain.MAPISession1
.DownLoadMail = False
.Username = ""
.LogonUI = True
.SignOn
End With
With frmMain.MAPIMessages1
.SessionID = frmMain.MAPISession1.SessionID
.Compose
.MsgIndex = -1
.RecipIndex = 0
.RecipAddress = txtTo
.RecipDisplayName = txtTo
.RecipType = mapToList
If txtCC <> "" Then
.RecipIndex = 1
.RecipDisplayName = txtCC
.RecipAddress = txtCC
.RecipType = mapCcList
End If
'spaces are important! need one space for each attachment
'NOTE .MsgNoteText = " " MUST be there see.. KB173853 in microsoft
.MsgSubject = txtSubjext
.MsgNoteText = Space$(UBound(vAttach) + 1) & vbCrLf
.MsgNoteText = txtBody & vbCrLf
For i = 0 To UBound(vAttach)
.AttachmentIndex = i
.AttachmentPosition = i
.AttachmentType = mapData
.AttachmentName = GetFileFromPath(vAttach(i))
.AttachmentPathName = vAttach(i)
Next i
StatusBar1.Panels(1).Text = "Status: Sending"
.send True
End With
More Info:
I'm making some progress. The error has to do with email type in outlook not being SMTP. If on the send-to email in the outlook compose dialog you right-click on the email address then select outlook properties and change the email type to SMTP it will work. The type displayed is the email address itself, valid values seem to be 'mailto' and 'smtp'. So if I can set the email type from vb6 it should fix the error.
The 'Answer'? https://kb.intermedia.net/article/2344
I can't believe there is no fix for this...
RESOLVED!
I realize this topic is most likely of no interest to anyone programming in the 20th century but here is the fix:
.RecipAddress = "SMTP:" & txtTo
It just came to me. :)

How to add custom mailheader using cdo.message in Vb6

I have tried to use the following code to add custom mail header in VB6. But it didnt work.
Can anyone help me out?
Dim lobj_cdomsg As CDO.Message
Set lobj_cdomsg = New CDO.Message
'Add the Project Reference Miscrosoft CDO WINDOWS FOR 2000
lobj_cdomsg.Configuration.Fields(cdoSMTPServer) = "servername"
lobj_cdomsg.Configuration.Fields(cdoSMTPConnectionTimeout) = 30
lobj_cdomsg.Configuration.Fields(cdoSendUsingMethod) = 2
lobj_cdomsg.Configuration.Fields(cdoSMTPAuthenticate) = 1
lobj_cdomsg.Configuration.Fields(cdoSendUserName) = "username"
lobj_cdomsg.Configuration.Fields(cdoSendPassword) = "password"
lobj_cdomsg.Configuration.Fields(cdoSMTPServerPort) = "587"
lobj_cdomsg.Configuration.Fields("urn:schemas:mailheader:X-MC-Tags") = "CKSR001"
'lobj_cdomsg.Fields("urn:schemas:mailheader:X-MC-Tags") = "CKSR002"
lobj_cdomsg.Configuration.Fields.Update
lobj_cdomsg.To = "to user"
lobj_cdomsg.From = "from"
lobj_cdomsg.Subject = "FROM VB6 CODSYS"
lobj_cdomsg.TextBody = "New Mail"
lobj_cdomsg.TextBody = "New Mail"
lobj_cdomsg.Send
Set lobj_cdomsg = Nothing
You have to add your "urn:schemas:mailheader:X-..." header as a field of the Message object, not Message.Configuration.
Add the following two lines before sending the message: (and remove your non-working line)
lobj_cdomsg.Fields("urn:schemas:mailheader:X-MC-Tags") = "CKSR001"
lobj_cdomsg.Fields.Update
Then it should work.

How send mail with vbscript?

i need to send a file attached to an email that must be setn to specific user through smtp server with auth. How can i do that in vbscript?
Thanks.
You can just take a look here:
how to send an email with attachment in vb.net?
Try the following:
Dim oMsg As System.Web.Mail.MailMessage = New System.Web.Mail.MailMessage()
oMsg.From = "noone#nobody.com"
oMsg.To = "someone#somewhere.com"
oMsg.Subject = "Email with Attachment Demo"
oMsg.Body = "This is the main body of the email"
Dim oAttch As MailAttachment = New MailAttachment("C:\myattachment.zip")
oMsg.Attachments.Add(oAttch)
SmtpMail.Send(oMsg)
I have no experience with vbscript of VB for that matter... But a quick Google gave me this result - it looks simple enough.
I hope this helps :)

VBScript Sending Email with High Importance

I used VBScript to write a function to send email automatically.
With .Configuration.Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "SMTPHOST.redmond.corp.microsoft.com"
.Item(cdoSMTPServerPort) = 25
.Item(cdoSMTPAuthenticate) = cdoNTLM
.Item("urn:schemas:httpmail:importance") = sMailPriority
.Update
When I want to send email with high important, I set the sMailPriority to 2. When I test with the Gmail, it worked. But when I using outlook2010, it didn't work.
Some e-mail clients requires different headers to set e-mail priority.
Try to add all of these fields.
.Item("urn:schemas:httpmail:importance") = sMailPriority
.Item("urn:schemas:httpmail:priority") = 1 'sMailPriority
.Item("urn:schemas:mailheader:X-Priority") = 1 'sMailPriority

Get EntryID of new mail

We made a script that automatically opens the Microsoft Outlook new mail window. Some things have to be filled in already. This works so far:
Set Arguments = WScript.Arguments
If Arguments.Count > 4 Then
Set Outlook = CreateObject("Outlook.Application")
Set BodyObject = CreateObject("Scripting.FileSystemObject")
Set Mail = Outlook.CreateItem(0)
Mail.To = Arguments(0)
Mail.CC = Arguments(1)
Mail.BCC = Arguments(2)
Mail.Subject = Arguments(3)
Set BodyFile = BodyObject.OpenTextFile(Arguments(4))
Mail.Body = BodyFile.ReadAll
BodyFile.Close
For Counter = 5 to (Arguments.Count - 1)
Mail.Attachments.Add Arguments(Counter)
Next
Mail.Display
End If
But know we want to know if that mail gets sent by the user and we also want to know the EntryID of that mail, so we can look it up later.
Now Mail.Display doesn't return anything and the program just ends. It does not wait until the window gets closed. So after Mail.Display, there should be something like: Mail.Wait, or a Mail send event so we can get the EntryID.
Could someone help us out?
Thanks in advance,
Gillis and Emiel
I just found a probable solution from here:
You need to wait and get the EntryID
value after the item has been
delivered from the Outbox. To do this,
subscribe to the Folder.Items.ItemAdd
event on the Sent Items folder. That
event passes the newly added -- i.e.
newly sent -- item as its argument.
The item must exist first in Outlook to have an EntryID value, use the Save Property and fetch its EntryID right after
Mail.Save
strEntryID = Mail.EntryID
I've got a sample written in VBA for saving notes from Access form to Outlook
Dim outobj As Outlook.Application
Dim outappt As Outlook.NoteItem
Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olNoteItem)
With outappt
If Not IsNull(Me!strBody) Then .Body = Me!strBody
.Save
Me!strEID = .EntryID
End With

Resources