Outlook VBscript method .Send stops scripts - vbscript

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).

Related

Saving email headers as .msg

Dear StackOverflowers.
I know a few programming languages, but unfortunately VBA is not one of them.
I'm trying to make a script that saves the headers from selected mails in Outlook as .msg-files.
I found a script that opens the headers as new messages, but how to I save them as e.g. [senders domain]_[date recieved].msg instead of opening them as new mails?
The script that I have:
Sub ViewInternetHeader()
Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem
Dim strHeader As String
For Each olItem In Application.ActiveExplorer.Selection
strHeader = GetInetHeaders(olItem)
Set olMsg = Application.CreateItem(olMailItem)
With olMsg
.BodyFormat = olFormatPlain
.Body = strHeader
.Display
End With
Next
Set olMsg = Nothing
End Sub
Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
' Purpose: Returns the internet headers of a message.'
' Written: 4/28/2009'
' Author: BlueDevilFan'
' //techniclee.wordpress.com/
' Outlook: 2007'
Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
Dim olkPA As Outlook.PropertyAccessor
Set olkPA = olkMsg.PropertyAccessor
GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
Set olkPA = Nothing
End Function
Use the MailItem.SaveAs method which saves the Microsoft Outlook item to the specified path and in the format of the specified file type. If the file type is not specified, the MSG format (.msg) is used. For example:
Sub SaveAsTXT()
Dim myItem As Outlook.Inspector
Dim objItem As Object
Set myItem = Application.ActiveInspector
If Not TypeName(myItem) = "Nothing" Then
Set objItem = myItem.CurrentItem
strname = objItem.Subject
'Prompt the user for confirmation
Dim strPrompt As String
strPrompt = "Are you sure you want to save the item? " & _
"If a file with the same name already exists, " & _
"it will be overwritten with this copy of the file."
If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
objItem.SaveAs Environ("HOMEPATH") & "\My Documents\" & strname & ".txt", olTXT
End If
Else
MsgBox "There is no current active inspector."
End If
End Sub
So you want an MSG file that has no recipients, attachments, subject, etc, only the MIME headers as the body? Why do you want the MSG format then?
You can create an populate a text file using the Scripting.FileSystemObject and use its CreateTextFile method.
Thank you, Eugene.
I managed to put in your code.
But it doesn't give the file a name, it's only called ".msg", and it doesn't work, when I try to select more than one email.
Also, how do I avoid, that it opens a new mail with the header?
I have this script now:
Sub ViewInternetHeader()
Dim olItem As Outlook.MailItem, olMsg As Outlook.MailItem
Dim strHeader As String
For Each olItem In Application.ActiveExplorer.Selection
strHeader = GetInetHeaders(olItem)
Set olMsg = Application.CreateItem(olMailItem)
With olMsg
.BodyFormat = olFormatPlain
.Body = strHeader
.Display
End With
Next
Set olMsg = Nothing
Dim myItem As Outlook.Inspector
Dim objItem As Object
Set myItem = Application.ActiveInspector
If Not TypeName(myItem) = "Nothing" Then
Set objItem = myItem.CurrentItem
strname = objItem.SenderEmailAddress
'Prompt the user for confirmation
Dim strPrompt As String
strPrompt = "Are you sure you want to save the item? " & _
"If a file with the same name already exists, " & _
"it will be overwritten with this copy of the file."
If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
objItem.saveas "C:\temp\" & strname & ".msg", OLTXT
End If
Else
MsgBox "There is no current active inspector."
End If
End Sub
Function GetInetHeaders(olkMsg As Outlook.MailItem) As String
Const PR_TRANSPORT_MESSAGE_HEADERS = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
Dim olkPA As Outlook.PropertyAccessor
Set olkPA = olkMsg.PropertyAccessor
GetInetHeaders = olkPA.GetProperty(PR_TRANSPORT_MESSAGE_HEADERS)
Set olkPA = Nothing
End Function

Outlook .Recipients.ResolveAll ambiguous name resolution failure

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

How to add multiple CC addresses in VB script send mail

How to add multiple email addresses in CC list for VB Script send mail.
option explicit
' --------------------------------------------------------------------------
' -- Create Lotus Notes email (and add attachment) using VB Script
' --
' -- Version 1.01
' --
' -- Created by : Michael Green
' -- migreen#westpac.com.au
' --
' -- Based on in-complete/partially working script from :
' -- http://en.allexperts.com/q/Using-Lotus-Notes-1427/Creating-LotusNotes-email-using-1.htm
' --
' -- Created : 06/10/2009
' -- Last Updated: 07/10/2009
' --------------------------------------------------------------------------
Dim oSession ' AS NotesSession
Dim strServer
Dim strUserName
Dim strMailDbName
Dim oCurrentMailDb ' as NOTESDATABASE
Dim oMailDoc ' as NOTESDOCUMENT
Dim ortItem ' as NOTESRICHTEXTITEM
Dim ortAttacment ' as NOTESRICHTEXTITEM
Dim oEmbedObject ' as ????
dim cstrAttachment
Dim blAttachment
cstrAttachment = "c:\Temp\Telstra.xls"
blAttachment = True
' Start a session to notes
wscript.echo "## Connecting to Lotus Notes session..."
Set oSession = CreateObject("Notes.NotesSession")
wscript.echo("NotesVersion : " & oSession.NotesVersion)
wscript.echo("NotesBuildVersion: " & oSession.NotesBuildVersion)
wscript.echo("UserName : " & oSession.UserName)
wscript.echo("EffectiveUserName: " & oSession.EffectiveUserName)
wscript.echo "## GetEnvironmentString..."
strServer = oSession.GetEnvironmentString("MailServer",True)
wscript.echo("Server :" & strServer)
' eg. CN=Michael V Green/OU=CORPAU/OU=WBCAU/O=WBG
strUserName = oSession.UserName
strMailDbName = Left(strUserName, 1) & Right(strUserName, (Len(strUserName) - InStr(1, strUserName, "")))&".nsf"
wscript.echo("MailDbName :" & strMailDbName)
wscript.echo "## Getting current Notes database..."
' open the mail database in Notes
set oCurrentMailDb = oSession.CurrentDatabase
wscript.echo("fileName:" & oCurrentMailDb.fileName)
wscript.echo("filePath:" & oCurrentMailDb.filePath)
wscript.echo("server:" & oCurrentMailDb.server)
wscript.echo("Title:" & oCurrentMailDb.Title)
If oCurrentMailDb.IsOpen = True Then
' Already open for mail
wscript.echo "## Lotus Notes mail database is already open !"
Else
wscript.echo "## Opening Lotus Notes mail database..."
oCurrentMailDb.OPENMAIL
End If
' Create a document in the back end
Set oMailDoc = oCurrentMailDb.CREATEDOCUMENT
' Set the form name to memo
OMailDoc.form = "Memo"
with oMailDoc
.SendTo = "migreen#westpac.com.au"
.BlindCopyTo = "mgreen#ozemail.com.au"
.CopyTo = "migreen#westpac.com.au"
.Subject = "This is a test of VB scripting driving Lotus Notes 7 "
end with
set ortItem = oMaildoc.CREATERICHTEXTITEM("Body")
with ortItem
.AppendText("Test of RTF Item append")
.AddNewLine(2)
.AppendText("Signature")
End With
' Create additional Rich Text item and attach it
If blAttachment Then
Set ortAttacment = oMailDoc.CREATERICHTEXTITEM("Attachment")
' Function EMBEDOBJECT(ByVal TYPE As Short, ByVal CLASS As String, ByVal SOURCE As String, Optional ByVal OBJECTNAME As Object = Nothing) As Object
' Member of lotus.NOTESRICHTEXTITEM
Set oEmbedObject = ortAttacment.EMBEDOBJECT(1454, "", cstrAttachment, "Attachment")
End If
wscript.echo "## Sending email..."
with oMailDoc
.PostedDate = Now()
.SAVEMESSAGEONSEND = "True"
.send(false)
end with
wscript.echo "## Sent !"
' close objects
set oMailDoc = nothing
set oCurrentMailDb = nothing
set oSession = nothing
Just use an array to set the values
with oMailDoc
.SendTo = Array( "migreen#westpac.com.au", "mgreen#westpac.com.au", "green#westpac.com.au" )
.BlindCopyTo = "mgreen#ozemail.com.au"
.CopyTo = "migreen#westpac.com.au"
.Subject = "This is a test of VB scripting driving Lotus Notes 7 "
end with
Originally I did not want to comment on the quality of the copied code at all. But the discussion with Lankymart made me think, it would be good to comment on it.
Set oSession = CreateObject("Notes.NotesSession")
This line creates an OLE interface to a running Notes- Client. If client does not run, then it will be started. If you used Set oSession = CreateObject("Lotus.NotesSession") then it would have been a COM- Object you get. Be aware, that Some OLE- Methods do not work in COM and vice versa. e.g. oCurrentMailDb.OPENMAIL is OLE, while the same thing in COM would be oCurrentMailDb.OpenMailDatabase()
' eg. CN=Michael V Green/OU=CORPAU/OU=WBCAU/O=WBG
strUserName = oSession.UserName
strMailDbName = Left(strUserName, 1) & Right(strUserName, (Len(strUserName) - InStr(1, strUserName, "")))&".nsf"
Getting the users' mailfile is completely nonsense, the code will get everything but a correct filename. As the variable is not used at all - can be forgotten
set oCurrentMailDb = oSession.CurrentDatabase
Just gets the database that is currently open in the client. If no database is open, an error will be thrown in the next wscript.echo- line, and we will never get to the next lines where it checks, if a database is open...
The problem with this line: Sending mails is possible from ANY database in Lotus Notes. If the database that is open e.g. is the personal addressbook, then the mail will be saved and sent from there (and you will never find it in the Sent- View of your mailfile.
I would suggest to use OPENMAIL first and only do a fallback to the currently open database if that fails.
The rest of the code seems to be OK.
Create an array of email address strings and set CopyTo to that array:
Dim addresses (2)
addresses(0) = "EMAIL"
addresses(1) = "EMAIL"
addresses(2) = "EMAIL"
with oMailDoc
.SendTo = "migreen#westpac.com.au"
.BlindCopyTo = "mgreen#ozemail.com.au"
.CopyTo = addresses
.Subject = "This is a test of VB scripting driving Lotus Notes 7 "
end with

How to send lotus notes mail with VB script with other mail box

Hi I am sending lotus notes mail with VB script . Now I want to send mail with other mail box which is opened in my lotus notes instead of my mail box. I tried different options but no luck. I am using below code to send mail.
You can find the code in below URL:
https://gallery.technet.microsoft.com/scriptcenter/fe141119-9599-46a7-90ca-8dbc66d50297
option explicit
' --------------------------------------------------------------------------
' -- Create Lotus Notes email (and add attachment) using VB Script
' --
' -- Version 1.01
' --
' -- Created by : Michael Green
' -- migreen#westpac.com.au
' --
' -- Based on in-complete/partially working script from :
' -- http://en.allexperts.com/q/Using-Lotus-Notes-1427/Creating-LotusNotes-email-using-1.htm
' --
' -- Created : 06/10/2009
' -- Last Updated: 07/10/2009
' --------------------------------------------------------------------------
Dim oSession ' AS NotesSession
Dim strServer
Dim strUserName
Dim strMailDbName
Dim oCurrentMailDb ' as NOTESDATABASE
Dim oMailDoc ' as NOTESDOCUMENT
Dim ortItem ' as NOTESRICHTEXTITEM
Dim ortAttacment ' as NOTESRICHTEXTITEM
Dim oEmbedObject ' as ????
dim cstrAttachment
Dim blAttachment
cstrAttachment = "c:\Temp\Telstra.xls"
blAttachment = True
' Start a session to notes
wscript.echo "## Connecting to Lotus Notes session..."
Set oSession = CreateObject("Notes.NotesSession")
wscript.echo("NotesVersion : " & oSession.NotesVersion)
wscript.echo("NotesBuildVersion: " & oSession.NotesBuildVersion)
wscript.echo("UserName : " & oSession.UserName)
wscript.echo("EffectiveUserName: " & oSession.EffectiveUserName)
wscript.echo "## GetEnvironmentString..."
strServer = oSession.GetEnvironmentString("MailServer",True)
wscript.echo("Server :" & strServer)
' eg. CN=Michael V Green/OU=CORPAU/OU=WBCAU/O=WBG
strUserName = oSession.UserName
strMailDbName = Left(strUserName, 1) & Right(strUserName, (Len(strUserName) - InStr(1, strUserName, "")))&".nsf"
wscript.echo("MailDbName :" & strMailDbName)
wscript.echo "## Getting current Notes database..."
' open the mail database in Notes
set oCurrentMailDb = oSession.CurrentDatabase
wscript.echo("fileName:" & oCurrentMailDb.fileName)
wscript.echo("filePath:" & oCurrentMailDb.filePath)
wscript.echo("server:" & oCurrentMailDb.server)
wscript.echo("Title:" & oCurrentMailDb.Title)
If oCurrentMailDb.IsOpen = True Then
' Already open for mail
wscript.echo "## Lotus Notes mail database is already open !"
Else
wscript.echo "## Opening Lotus Notes mail database..."
oCurrentMailDb.OPENMAIL
End If
' Create a document in the back end
Set oMailDoc = oCurrentMailDb.CREATEDOCUMENT
' Set the form name to memo
OMailDoc.form = "Memo"
with oMailDoc
.SendTo = "migreen#westpac.com.au"
.BlindCopyTo = "mgreen#ozemail.com.au"
.CopyTo = "migreen#westpac.com.au"
.Subject = "This is a test of VB scripting driving Lotus Notes 7 "
end with
set ortItem = oMaildoc.CREATERICHTEXTITEM("Body")
with ortItem
.AppendText("Test of RTF Item append")
.AddNewLine(2)
.AppendText("Signature")
End With
' Create additional Rich Text item and attach it
If blAttachment Then
Set ortAttacment = oMailDoc.CREATERICHTEXTITEM("Attachment")
' Function EMBEDOBJECT(ByVal TYPE As Short, ByVal CLASS As String, ByVal SOURCE As String, Optional ByVal OBJECTNAME As Object = Nothing) As Object
' Member of lotus.NOTESRICHTEXTITEM
Set oEmbedObject = ortAttacment.EMBEDOBJECT(1454, "", cstrAttachment, "Attachment")
End If
wscript.echo "## Sending email..."
with oMailDoc
.PostedDate = Now()
.SAVEMESSAGEONSEND = "True"
.send(false)
end with
wscript.echo "## Sent !"
' close objects
set oMailDoc = nothing
set oCurrentMailDb = nothing
set oSession = nothing
Just replace the lines (that are complete nonsense, but I told you in the other post):
strMailDbName = Left(strUserName, 1) & Right(strUserName, (Len(strUserName) - InStr(1, strUserName, "")))&".nsf"
wscript.echo("MailDbName :" & strMailDbName)
wscript.echo "## Getting current Notes database..."
' open the mail database in Notes
set oCurrentMailDb = oSession.CurrentDatabase
wscript.echo("fileName:" & oCurrentMailDb.fileName)
wscript.echo("filePath:" & oCurrentMailDb.filePath)
wscript.echo("server:" & oCurrentMailDb.server)
wscript.echo("Title:" & oCurrentMailDb.Title)
If oCurrentMailDb.IsOpen = True Then
' Already open for mail
wscript.echo "## Lotus Notes mail database is already open !"
Else
wscript.echo "## Opening Lotus Notes mail database..."
oCurrentMailDb.OPENMAIL
End If
with
strServer = "ServerNameWhereMailboxIs"
strMailDbName = "mail\nameofotherdatabase.nsf"
set oCurrentMailDb = oSession.GetDatabase( strServer, strMailDbName )
That will do the trick.
As your question changed after my answer, I will -for the sake of anybody finding this question in the future- add some code for "sending an email in the name of another sender":
In Lotus Notes it is not possible to "send" a mail without leaving traces of the person who really sent it:
When you receive such a mail, that was sent by someone else you will see, that the mail comes from the other mailbox, but it will contain the information "Sent by" with the mailaddress of the "real" sender.
To at least make the "visual" sender look right, you need to add different fields that are needed in different cases: These fields are Principal, InetPrincipal, From and InetFrom.
However: On a Domino- Server that is configured right, this will not help: It will calculate these fields from the "real" sender and ignore what you gave him.
But there is a trick to make the router leave these fields alone: You have to add the NotesDomain to the adressen. If you add the following lines to your code, then the router will ignore these and keep the fields intact:
MailDoc.principal = "noreply#company.com#NotesDomain"
MailDoc.inetprincipal = "noreply#company.com#NotesDomain"
MailDoc.from = "noreply#company.com#NotesDomain"
MailDoc.inetfrom = "noreply#company.com#NotesDomain"
If you really need to "hide" the real sender completely from the recipient, then you cannot create the mail in the mail database, but create it directly in the "mail.box" of the server and just "Save" it instead of "Send" it. But this has other downsides and will not be discussed here.
I just want to leave one more answer about "send from/reply to" because this question here is what I found when I was searching for help:
I found out that only my own mailadress is shown to external recipients or people not using IBM notes. Even if I sent mails via a different mailfile (a Mail-In) only my own mailadress was shown and I also was the one the recipient could reply to. So I tried something, and it worked.
After some testing, this lines helped me out internal and external:
sender = """John Doe""" & "<support#domain.de>"
MailDoc.ReplyTo = sender
MailDoc.SMTPOriginator = sender
MailDoc.sender = sender
MailDoc.principal = sender
MailDoc.inetprincipal = sender
MailDoc.from = sender
MailDoc.inetfrom = sender
MailDoc.displayfrom = sender

Add bcc recipient to Outlook 2010 from vbs

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:

Resources