I have following script for sending email. When i run this script on normal cmd window with command
EmailTo.vbs "email" "Subject" "msgBody"
I get the email in my inbox, but when i run this in admin command window then i get Error:
Error: could not create object named "Outllok.Application"
Code: 8008005
Source: WScript.CreateObject
For Automation, I need to run this vbs in admin command mode. but it does not run in admin mode.
Dim ToAddress
Dim MessageSubject
Dim MessageBody
Dim MessageAttachment
addAttachment = 0
Dim ol, ns, newMail
ToAddress = Wscript.Arguments(0)
MessageSubject = Wscript.Arguments(1)
MessageBody = Wscript.Arguments(2)
if Wscript.Arguments.Count > 3 Then
addAttachment=1
MessageAttachment = Wscript.Arguments(3)
End If
' connect to Outlook
Set ol = WScript.CreateObject("Outlook.Application")
Set ns = ol.getNamespace("MAPI")
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.Body = MessageBody & vbCrLf
' validate the recipient, just in case...
Set myRecipient = ns.CreateRecipient(ToAddress)
myRecipient.Resolve
If Not myRecipient.Resolved Then
MsgBox "Unknown recipient"
Else
newMail.Recipients.Add(ToAddress)
if addAttachment = 1 Then newMail.Attachments.Add(MessageAttachment).Displayname = "Check this out" End If
newMail.Send
End If
Set ol = Nothing
I think you might need to late bind when creating your mail item:
Set newMail = ol.CreateItem(0)
olMailItem enumerates to 0
Related
I have code that upon click, opens up a pre-defined Outlook Message.
My problem is, when the Outlook message window opens, my VB.Net app freezes until, the Outlook message window is either closed or the mail is sent.
How can I release the object from vb.net so the my app is normal to use and not frozen in time?
My Code:
Dim EmailImgPath, strMsg As String
If CustID = vbEmpty Then
MsgBox("No Client selected. Please select a client first before clicking on the Notifications Email button.", vbExclamation + vbOKOnly, "No Client Selected")
Else
If cmbOrdStatus.Text = "Ready" Then
Try
Dim Outl As Object
Outl = CreateObject("Outlook.Application")
If Outl IsNot Nothing Then
Dim omsg As Object
omsg = Outl.CreateItem(0) '=Outlook.OlItemType.olMailItem'
omsg.To = txtEmail1.Text
omsg.cc = txtEmail2.Text
omsg.bcc = EmailBcc
omsg.subject = "Order Update from EyeStyle Opticians"
strMsg = strMsg & "<p>Dear " & txtFname.Text & ",<br><br>"
strMsg = strMsg & "<p>Great News!"
strMsg = strMsg & "<p>Your order is ready for collection"
strMsg = strMsg & "<p>For any enquiries please call 0734 544376 / 0726 936136 / 0707 908838"
strMsg = strMsg & "<p>Thank you for your patronage and assuring you of our very best services at all times."
strMsg = strMsg & "<p>Karibu."
strMsg = strMsg & "<p>Eyestyle Opticians Ltd.<br><br>"
strMsg = strMsg & "<p><img src=" & EmailImgPath & "></p>"
omsg.HTMLBody = strMsg
omsg.Display(True) 'will display message to user
End If
Outl = Nothing
Catch ex As Exception
MessageBox.Show("ERROR: Failed to send mail: " & ex.Message)
End Try
End If
The following shows how to use Microsoft.Office.Interop.Outlook to send an e-mail. It's been tested.
Pre-requisite: Outlook installed.
Add Reference:
Note: The instructions below are for VS 2019.
In VS menu, click Project
Select Add Reference...
Click COM
Check Microsoft Outlook xx.x Object Library (ex: Microsoft Outlook 16.0 Object Library)
Click OK
Add Imports statement
Imports Outlook = Microsoft.Office.Interop.Outlook
CreateMsg:
Private Sub CreateMsg(toAddress As String)
Dim oApp As Outlook.Application = Nothing
Dim oNS As Outlook.NameSpace = Nothing
Try
'create new instance
oApp = New Outlook.Application()
'get MAPI namepsace
oNS = oApp.GetNamespace("mapi")
'log on using default profile
oNS.Logon()
'logon using specified profile
'oNS.Logon("profileName", System.Reflection.Missing.Value, False, true)
'create MailItem
Dim oMsg As Outlook.MailItem = DirectCast(oApp.CreateItem(Outlook.OlItemType.olMailItem), Outlook.MailItem)
'ToDo: change the message properties as desired (ie: subject, body, etc...)
oMsg.To = toAddress
oMsg.Subject = "this is the subject"
oMsg.Body = "This is a test " & DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss.fff")
'send message
For Each account As Outlook.Account In oApp.Session.Accounts
Debug.WriteLine($"account SMTP address: {account.SmtpAddress}")
If account.SmtpAddress = "desiredFromAddress#outlook.com" OrElse oApp.Session.Accounts.Count = 1 Then
Debug.WriteLine($"Sending from {account.SmtpAddress}...")
oMsg.SendUsingAccount = account
oMsg.Send()
Exit For
End If
Next
'sleep to allow send to complete
System.Threading.Thread.Sleep(150)
'send and receive
oNS.SendAndReceive(False)
'log off
oNS.Logoff()
'oMsg.Display(True)
'oMsg.Display(False)
Finally
If oApp IsNot Nothing Then
oApp.Quit()
End If
End Try
End Sub
Resources:
Microsoft.Office.Interop.Outlook
Work with mail items
How to: Programmatically create an email item
Outlook Automatic Send Receive not Working (Solved)
COM Interop & Outlook - Make Outlook Visible?
How to use the Microsoft Outlook Object Library to retrieve a message from the Inbox by using Visual C#
How to send a mail using Microsoft.Office.Interop.Outlook.MailItem by specifying the From Address
How To: Perform Send/Receive in Outlook programmatically
Outlook error when sending more than one mail: "The item has been moved or deleted"
Outlook Interop: MailItem stuck in Outbox
Outlook Integration in C#
I am trying to automate sending an email and copy the meeting organizer through an Outlook VBA macro. My company is using Office 365.
I am using the item.GetOrganizer element to get the organizer's name.
Debug.Print oItem.GetOrganizer.Address gives:
/o=ExchangeLabs/ou=Exchange Administrative Group (FYDIBOHF23SPDLT)/cn=Recipients/cn=c035bc5647d64d89aecbc6d3ddb5580b-Name
How do I get the email address?
Example
Option Explicit
Private Function GetMeetingOrganizer( _
ByVal appt As Outlook.AppointmentItem) As Outlook.AddressEntry
If appt Is Nothing Then Exit Function
Dim PR_SENT_REPRESENTING_ENTRYID As String
PR_SENT_REPRESENTING_ENTRYID = _
"http://schemas.microsoft.com/mapi/proptag/0x00410102"
Dim organizerEntryID As String
organizerEntryID = _
appt.PropertyAccessor.BinaryToString( _
appt.PropertyAccessor.GetProperty(PR_SENT_REPRESENTING_ENTRYID))
Dim organizer As Outlook.AddressEntry
Set organizer = Application.Session.GetAddressEntryFromID(organizerEntryID)
If organizer Is Nothing Then
Debug.Print "No organizer" ' Print on Immediate Window
Else
Debug.Print organizer ' Print on Immediate Window
Dim Email_Address As String
If organizer.Type = "SMTP" Then
Email_Address = organizer.Address
Else
If organizer.Type = "EX" Then
Email_Address = organizer.GetExchangeUser.PrimarySmtpAddress
End If
End If
Debug.Print Email_Address ' Print on Immediate Window
End If
End Function
Private Sub Example()
Dim Item As Object
Set Item = ActiveExplorer.Selection.Item(1)
Debug.Print TypeName(Item)
GetMeetingOrganizer Item
End Sub
Function GetOrganizerEmail(ApptItem As Outlook.AppointmentItem) As String
Dim organizer As Outlook.AddressEntry
Set org = ApptItem.GetOrganizer
If org.Type = "SMTP" Then
GetOrganizerEmail = org.Address
ElseIf org.Type = "EX" Then
GetOrganizerEmail = org.GetExchangeUser.PrimarySmtpAddress
End If
End Function
I want to create POST request for my ServiceNow Instance API. But I don't know how to use library VBA-Web.
I want to create a row in my table in ServiceNow.
My code:
Sub ToRequestSN()
Dim Body As New Dictionary
Body.Add "u_any_string", "test"
Body.Add "u_any_numeral", 12
Dim Client As New WebClient
Dim Response As WebResponse
Set Response = Client.PostJson("https://instance.sn.ru/api/now/table/u_table_test", Body)
Debug.Print Response.Content
End Sub
But I got this message -
{"error":{"message":"User Not Authenticated","detail":"Required to provide Auth information"},"status":"failure"}
How I can log in using VBA-Web?
I found solution. I did send selected mail (email of sender) and pass to Service Now.
Sub RequestToSN()
Dim Client As New WebClient
Dim Response As WebResponse
Dim Auth As New HttpBasicAuthenticator
Dim Body As New Dictionary
Dim myOlSel As Outlook.Selection
Dim oMail As Outlook.MailItem
Dim myOlExp As Outlook.Explorer
MsgTxt = ""
Set myOlExp = Application.ActiveExplorer
Set myOlSel = myOlExp.Selection
For x = 1 To myOlSel.Count
If myOlSel.Item(x).Class = OlObjectClass.olMail Then
Set oMail = myOlSel.Item(x)
MsgTxt = MsgTxt & oMail.SenderName
''Date = Date & oMail.CreationTime
End If
Next x
Body.Add "u_any_string", MsgTxt
Body.Add "u_any_numeral", 123
Auth.Setup _
Username:="user", _
Password:="user"
Set Client.Authenticator = Auth
Set Response = Client.PostJson("https://service.sn.com/api/now/table/u_table_test", Body)
End Sub
Sub Initialize
On Error GoTo e
Dim session As New NotesSession, db As NotesDatabase, view As NotesView
Dim nvec As NotesViewEntryCollection
Dim c As integer
Set db = session.currentdatabase
Set view = db.getView("Locked Out Users")
Set nvec = view.Allentries
c = nvec.count
If c > 0 Then
Call nvec.Removeall(true)
' Send notification
Dim sarr(1) As String
sarr(0) = "john.doe#acme.com"
sarr(1) = "foo#acme.com"
Dim mdoc As NotesDocument, rt As notesrichtextitem
Set mdoc = db.createdocument
mdoc.Form = "Memo"
mdoc.Subject = "Removed " + CStr(c) + " Locked out users on mypage"
Set rt = mdoc.Createrichtextitem("Body")
Call rt.Appendtext("Removed " + CStr(c) + " Locked out users")
Call rt.Addnewline(1)
Call rt.Appendtext("Click to open lockout database")
Call rt.Appenddoclink(db,"Lockout")
Call mdoc.Send(False, sarr)
End If
Exit Sub
e:
Print Error,erl
End Sub
I’m a beginner in Lotus Domino it I have some question , It's possible to change this script to delate only locked users with specified name?
I added something like that:
Dim nam As NotesName
Dim c As integer
Set db = session.currentdatabase
Set nam.OrgUnit1 = (“GD”)
Set view = db.getView("Locked Out Users")
Set nvec.OrgUnit1 = view.Allentries
c = nvec.count
If c > 0 Then
In my case I need delete all group person how has specified dc, for example Robert Kowalski/GD/Company everybody how has in name dc=GD?
There are at least 2 ways to achieve your request.
First you can copy the view "Locked Out Users" and change the selection formula to only include your OU.
The other option is something like
dim doc as notesdocument
dim nextDoc as notesdocument
set doc = view.getfirstdocument()
while not doc is nothing
set nextDoc = view.getnextDocument(doc)
set nam = new notesname(doc.getItemValue("[NAMEITEM]")(0))
if strcompare(nam.orgUnit1,"GD",5)=0 then
call doc.remove(true,false)
end if
set doc = nextDoc
wend
Sub Initialize
On Error GoTo e
Dim session As New NotesSession, db As NotesDatabase, view As NotesView
Dim nvec As NotesViewEntryCollection
Dim c As integer
Set db = session.currentdatabase
dim doc as notesdocument
dim nextDoc as notesdocument
set doc = view.getfirstdocument()
while not doc is nothing
set nextDoc = view.getnextDocument(doc)
set nam = new notesname(doc.getItemValue("[NAMEITEM]")(0))
if strcompare(nam.orgUnit1,"GD",5)=0 then
call doc.remove(true,false)
end if
set doc = nextDoc
wend
Set view = db.getView("Locked Out Users")
Set nvec = view.Allentries
c = nvec.count
If c > 0 Then
Call nvec.Removeall(true)
' Send notification
Dim sarr(1) As String
sarr(0) = "john.doe#acme.com"
sarr(1) = "foo#acme.com"
Dim mdoc As NotesDocument, rt As notesrichtextitem
Set mdoc = db.createdocument
mdoc.Form = "Memo"
mdoc.Subject = "Removed " + CStr(c) + " Locked out users on mypage"
Set rt = mdoc.Createrichtextitem("Body")
Call rt.Appendtext("Removed " + CStr(c) + " Locked out users")
Call rt.Addnewline(1)
Call rt.Appendtext("Click to open lockout database")
Call rt.Appenddoclink(db,"Lockout")
Call mdoc.Send(False, sarr)
End If
Exit Sub
e:
Print Error,erl
End Sub
Thank You #umeli for Yours responce. I think now
it should work.
How would I get a folder that I, as a user, have been added to.
I need to do an addin for work, how would I access an inbox which isn't mine?
So the top one is my personal inbox, I need to access the inbox within 'MIS'.
Private Sub ThisApplication_NewMail() Handles Application.NewMail
Dim myNameSpace = Application.GetNamespace("MAPI")
Dim oParentFolder = myNameSpace.Folders("MIS")
Dim mis = oParentFolder.Folders.Item("Inbox")
Dim moveMail As Outlook.MailItem = Nothing
Dim mItems As Outlook.Items = mis.Items
mItems.Restrict("[Read] = true")
Dim destFolder As Outlook.MAPIFolder = mis.Folders("Test")
Dim SubjName = "TestingAddin123"
Dim sender As String = "michael"
Dim FName As String = "[Some recurring subject]"
Dim tStamp As String = Format(DateTime.Now, "ddMMyy").ToString()
Try
For Each eMail As Object In mItems
moveMail = TryCast(eMail, Outlook.MailItem)
If Not moveMail Is Nothing Then
If InStr(moveMail.SenderEmailAddress, sender) Then
If InStr(moveMail.Subject, SubjName) > 0 Then
Dim rn As New Random
Dim n = rn.Next(1, 9999)
'n()
moveMail.SaveAs("W:\NS\" & FName & "_" & tStamp & n.ToString() + ".html", Outlook.OlSaveAsType.olHTML)
moveMail.Move(destFolder)
End If
End If
End If
Next eMail
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
So I'm using the above code so far but I don't seem to be able to find the MIS Inbox.
How would I achieve this?
Try to use the Namespace.CreateRecipient / Namespace.GetSharedDefaultFolder methods.