Fetch an Unread email from a particular address in outlook with VB Script - vbscript

I want to get the email address of the unread mail which is from a particular sender.i tried the following code but it did'nt work
Set olApp=CreateObject("Outlook.Application")
Set olMAPI=olApp.GetNameSpace("MAPI")
Set oFolder = olMAPI.GetDefaultFolder(6)
Set allEmails = oFolder.Items
For Each email In oFolder.Items
If email.Unread = True Then
If email.SenderEmailAddress="Kalyanam.Raghuram#xxxx.com" Then
MsgBox email.Subject
End If
End If
Next
so i checked what actually 'email.SenderEmailAddress' is verifying with then by inserting this code
For Each email In oFolder.Items
If email.Unread = True Then
MsgBox email.Subject
MsgBox email.SenderEmailAddress
End If
Next
it gave me some output which cannot be understood but readable.Please let me know any solution for it.

Dio you mean you got back an EX type address instead of the expected SMTP?
Have you looked at the _ExchangeUser.PrimarySmtpAddress?
In your case you can use MailItem.Sender.GetExchangeUser.PrimarySmtpAddress. Be prepared to handle nulls as each value can be null.

The code you posted worked for me, I am on Windows Vista with Outlook 2007
One thing I would change is this
If LCase(email.SenderEmailAddress) = LCase("Kalyanam.Raghuram#xxxx.com") Then
wscript.echo email.Subject
End If

Related

Spaces and carriage returns are being added to HTML email

We have a server generated HTML file (myFile.html) that we embed in emails that get sent to our clients. We've been using this method for years with minimal issues. We use Windows Server 2012 with smtp server via II6. Recently the HTML is getting skewed in the email. When checking the source file, all looks well. Directly opening the HTML file for viewing in a browser works as you'd expect. Here is the code we're using to read the file into memory to prepare for emailing:
Set objFile = objFSO.OpenTextFile(strFilePath)
Do While objFile.AtEndOFStream <>True
line = objFile.ReadLine
If Instr(1, line, "<table") > 0 And strHeaderWritten = "N" Then
strHeaderWritten = "Y"
strFileContent=strFileContent & strHeader
End If
strFileContent=strFileContent & line
Loop
set objFile = Nothing
And then we add the content to the email and send:
strBody = strFileContent
Set objMail = CreateObject("CDO.Message")
Set objMail.Configuration = cdoConfig
objMail.From = strFrom
objMail.ReplyTo = strReplyTo
objMail.To = strTo
objMail.Subject = strSubject
objMail.HTMLBody = strBody
objMail.Fields("urn:schemas:httpmail:importance").Value = strImportance
objMail.Send
And here are examples of what it spits out in the email. There are no errors in the source:
Has anyone else had this happen to them?
Been toiling over this for hours looking for an explanation. Thank so much for reading!
I tried using the ADO Stream method for the email, but it is still coming out the same:
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 2 'adTypeText
objStream.CharSet = Application("CharacterSet")
objStream.Open
objStream.LoadFromFile strFilePath
Do While Not objStream.EOS
line = objStream.ReadText(-2)
If Instr(1, line, "<table") > 0 And strHeaderWritten = "N" Then
strHeaderWritten = "Y"
strFileContent=strFileContent & strHeader
End If
If Instr(1, line, "< table") > 0 Then
strFileContent=strFileContent & "<h3>Broken HTML</h3>"
End If
strFileContent=strFileContent & line
Loop
objStream.Close
Set objStream = Nothing
As you can see, I also added a check for one of the persistent errors I'm seeing where there has been a space inserted between < and table. Checking the output this way did not capture the issue as in checking the text for the added space. So it must be happening after it's been written or I need to use a regex for the test. I'll try that next. I'm still seeing it in multiple email clients. Here's an example post test of ADO Stream:
This seems to be a common problem in CDO. I've found a few references online to the problem that spaces are randomly inserted into the HTMLbody.
One answer was to make the HTML body not one long string, because CDO will then insert random spaces, but to include whitespace yourself, so that CDO doesn't have to.
You could try adding VbCrLf or just plain spaces in the text you're sending.
A second suggestion made more sense to me; this can be an encoding problem. That also explains why adding your own whitespace could be a workaround.
Anyway; CDO allows for setting the encoding of the CDO.Message object before sending.
Try objMail.BodyPart.ContentTransferEncoding = "quoted-printable" to see if that solves it.
The issue is windows use of both line break and carrage return. I recommend loading the body of the text and replacing all instances of vbcrlf with just vblf and you will find you wont have the double spacing anymore.
e.g.
body = replace(body, vbcrlf, vblf)

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 default signature and new tables in a new outlook mail by testcomplete

I am trying to send new outlook mail by testcomplete using vb scripting language .In that new mail i want to add new tables and keep default signature at bottom of mail by testcomplete. i am getting VB script run time error when i am using this code..please check the code and suggest me the correct methods i have to use to add new tables and signature
Function SendMail()
Dim objOutLook, NamespaceMAPI,objNewMail, fso, SendReceiveControls
Dim strTo,strCc ,strBcc ,strSubject, AccountName,strAttachmentPath
strSubject="test"
strTo=yyy#yy.com
strCc=XXX#XX.com
strBcc =zzz#zzz.com
strAttachmentPath="c:\text.txt"
Set objOutLook = CreateObject("Outlook.Application")
Set NamespaceMAPI = objOutLook.GetNamespace("MAPI")
Set objNewMail = objOutLook.CreateItem(olMailItem)
objOutLook.DisplayAlerts =True
objNewMail.TO = strTo
objNewMail.CC = strCc
objNewMail.BCC=strBcc
objNewMail.Subject = strSubject
objNewMail.Body = strMsg
If strAttachmentPath <> "" Then
Set fso =CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strAttachmentPath) Then
objNewMail.Attachments.Add(strAttachmentPath)
objNewMail.GetDefaultsignature() 'script run time error occured here
objNewMail.addtable(4,3)
objNewMail.display
Else
msgbox "Attachment File Does not exists"
End If
End If
objOutLook.Quit
''''''' Releasing objects '''''''
Set objOutLook =Nothing
Set objNewMail = Nothing
Set fso = Nothing
End Function
please help me.. thanks in advannce....
See if this or this helps. They are alternative methods to yours.
I prefer to use the 2nd option, the CDO method, you just need to take atention to the fact that usually this email goes to the spam inbox, you need to manually add it to your secure contacts

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

Sending email from webpage using Outlook

I have a webpage that has a button that sends a letter on the page to an email recipent. Currently we are use Lotus Notes and with VB script, we are able to create an object of Lotus Notes and one of the properties for this object is PutInFolder. After the user clicks on the email button, the script will send the email and also put save the email in a certain folder on the user's computer. Our company is now switching over to Outlook 2007 and I'm looking to do the same thing with an Outlook object instead. Our development is local intranet only, and there are only a few users that will have access to this. Anyway, my problem is I cannot seem to find the same functionality with an Outlook Application.
I do have the send of the email currently working using this logic. Does anyone have any ideas on how to save the email in the user's outlook folder? I tried looking for a list of properties that I can call but I cannot find anything searching. Maybe I don't have the right terminalogy in the searches.
Thank you.
sub send_mailvb(sendto, sendcc, sendbcc, subject_text, body_text, attachment1, attachment2, attachment3)
'Open mail, adress, attach report
dim objOutlk 'Outlook
dim objMail 'Email item
dim strMsg
const olMailItem = 0
'Create a new message
set objOutlk = createobject("Outlook.Application")
set objMail = objOutlk.createitem(olMailItem)
' Setup send to
objMail.To = sendto
' Setup send cc
If sendcc <> "" Then
objMail.cc = sendcc
End If
' Setup send bcc
If sendbcc <> "" Then
objMail.bcc = sendbcc
End If
'Set up Subject Line
objMail.subject = subject_text
'Add the body
strMsg = body_text & vbcrlf
'Add an attachments
If attachment1 <> "" Then
objMail.attachments.add(attachment1)
End If
If attachment2 <> "" Then
objMail.attachments.add(attachment2)
End If
If attachment3 <> "" Then
objMail.attachments.add(attachment3)
End If
objMail.body = strMsg
objMail.display 'Use this to display before sending, otherwise call objMail.Send to send without reviewing
'Clean up
set objMail = nothing
set objOutlk = nothing
End Sub
For future reference... I found the solution I was looking for. It wasn't too bad of a mess. Here's the modified source to replicate the Send and save email to a specific folder incase someone else comes looking. Thanks to Tester101 for the website I was looking for. Again this is vbscript imbedded in the HTML page.
sub send_mailvb(sendto, sendcc, sendbcc, subject_text, body_text, attachment1, attachment2, attachment3)
'Open mail, adress, attach report
dim objOutlk 'Outlook
dim objMail 'Email item
dim strMsg
dim myInbox
const olMailItem = 0
'Create a new message
set objOutlk = createobject("Outlook.Application")
Set objNameSpace = objOutlk.Session
set objMail = objOutlk.createitem(olMailItem)
Set myNameSpace = objOutlk.GetNamespace("MAPI")
Set myExplorer = objOutlk.ActiveExplorer
' 6 at least on my machine pointed to the Inbox (should be the same as constant olFolderInbox). Within the Inbox I have a folder called Test
Set myExplorer.CurrentFolder = myNameSpace.GetDefaultFolder(6).Folders("Test")
Set myFolder = myExplorer.CurrentFolder
' Setup send to
objMail.To = sendto
' Setup send cc
If sendcc "" Then
objMail.cc = sendcc
End If
' Setup send bcc
If sendbcc "" Then
objMail.bcc = sendbcc
End If
'Set up Subject Line
objMail.subject = subject_text
'Add the body
strMsg = body_text & vbcrlf
'Add an attachments
If attachment1 "" Then
objMail.attachments.add(attachment1)
End If
If attachment2 "" Then
objMail.attachments.add(attachment2)
End If
If attachment3 "" Then
objMail.attachments.add(attachment3)
End If
objMail.body = strMsg
// objMail.display 'Use this to display before sending, otherwise call objMail.Send to send without reviewing
objMail.Save
objMail.Move(myFolder)
objMail.Send
'Clean up
set objMail = nothing
set objOutlk = nothing
End Sub
I found this article. It might be something tha could help.
http://www.outlookcode.com/codedetail_print.aspx?id=1041
If not this site has great resources for working with outlook.
It looks like the MailItem object has a Save method, as well as a SaveAs method. So you should be able to do something like this.
objMail.SaveAs "C:\Test.msg", 3
The 3 is to save the message in olMSG format see OlSaveAsType Enumeration.
I have a solution. We've decided to bcc the person sending the email and then use an outlook rule to move the email to the specified outlook folder. Thanks to everyone that replied.

Resources