I am trying to develop a database where teachers log an application for when they need a lesson to be covered (I'd do this in SQL but I can't currently).
I would like the database to notify a certain member of staff when an application is made. Selecting the member of staff would be done from a combobox, driven by a query. The reason for the query is that I only want specific members of staff to receive this notification - essentially those who manage other staff.
Once that member of staff has been selected, I want the person making the application to click a button, which will then fire an email to the person selected in the combobox.
I get a flicker of Outlook doing something and then nothing.
This is what I have so far, with the DLookup using the staff member selected in the combobox to then find the email address in the Staff table:
Private Sub Command788_Click()
Dim Email_Note As Variant
Email_Note = DLookup("Email", "Staff", Forms![Cover Application Form]!Combo767)
Dim olLook As Outlook.Application
Dim olNewEmail As Outlook.CreateItem
Dim StrContactEmail As String
Set olLook = New Outlook.Application
Set olNewEmail = olLook.CreateItem(olMailItem)
strEmailSubject = "Application for Cover: Line Manager Notification"
strEmailText = "Something in here..."
StrContactEmail = "Email_Note"
olNewEmail.Display
End Sub
You should ensure that the Outlook library is referenced in the tools tab of VBA Editor. It also looks like you created strings for the body and subject but didn't declare them. Instead of declaring them as string variables just set the outlook. body etc. to the appropriate string as I have shown below.
You don't need to encapsulate email_note with quotes once you have declared it as a variable. I assumed that was an email address?
The strContactEmail is no longer needed, I don't see where it is used.
Private Sub Command788_Click()
Dim Email_Note As Variant
Email_Note = DLookup("Email", "Staff", Forms![Cover Application Form]!Combo767)
Dim olLook As Outlook.Application
Dim olNewEmail As Outlook.mailItem
'Dim StrContactEmail As String
Set olLook = New Outlook.Application
Set olNewEmail = olLook.CreateItem(olMailItem)
olNewEmail.Subject="Application for Cover: Line Manager Notification"
olNewEmail.Body = "Something in here..."
olNewEmail.To = email_note
olNewEmail.Send
Set olNewEmail = Nothing
Set olLook = Nothing
End Sub
Related
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 4 months ago.
Improve this question
I have inherited a database which has VBA code, unfortunately the colleague has left the organisation and we need to make 4 amendments. 1 - The code works on your personal inbox however we have moved to a team mailbox, so can anyone assist with how to change the code to address this? 2 - We need to pull the senders email address currently it pulls the persons name on occasion it will identify an email but that is very limited (is it to do with the SMTP address?) 3 - we would like to put a date range for the pulling of emails. 4- Once it has imported the emails can it move them to a folder called imported.
Thanks
Sub ImportMailPropFromOutlook()
' Code for specifing top level folder and initializing routine.
' Set up Outlook objects.
Dim ol As New Outlook.Application
Dim olns As Outlook.Namespace
Dim ofO As Outlook.MAPIFolder
Dim ofSubO As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Set olns = ol.GetNamespace("MAPI")
Set ofO = olns.GetDefaultFolder(olFolderInbox) '--- Specifies top level folder for importing Oultook mail.
'Set of = olns.PickFolder '--- Allows user to select top level folder for importing Outlook mail.
'Set info and call GetMailProp code.
Set objItems = ofO.Items
GetMailProp objItems, ofO
'Set info and call ProcessSubFolders.
'For Each ofSubO In of.Folders
' Set objItems = ofSubO.Items
' ProcessSubFolders objItems, ofSubO
'Next
End Sub
Sub GetMailProp(objProp As Outlook.Items, ofProp As Outlook.MAPIFolder)
' Code for writeing Outlook mail properties to Access.
' Set up DAO objects (uses existing Access "Email" table).
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("Email")
'Set Up Outlook objects.
Dim cMail As Outlook.MailItem
Dim cAtch As Outlook.Attachments
'Write Outlook mail properties to Access "Email" table.
iNumMessages = objProp.Count
If iNumMessages <> 0 Then
For i = 1 To iNumMessages
If TypeName(objProp(i)) = "MailItem" Then
Set cMail = objProp(i)
'If ([rst]![EmailLocation] <> ofProp.Name) And ([rst]![EntryID] <> cMail.EntryID) Then
rst.AddNew
rst!EntryID = cMail.EntryID
rst!ConversationID = cMail.ConversationID
rst!Sender = cMail.Sender
rst!SenderName = cMail.SenderName
rst!SentOn = cMail.SentOn
rst!To = cMail.To
rst!CC = cMail.CC
rst!BCC = cMail.BCC
rst!Subject = cMail.Subject
Set cAtch = cMail.Attachments
cntAtch = cAtch.Count
If cntAtch > 0 Then
For j = cntAtch To 1 Step -1
strAtch = cAtch.Item(j).FileName
rst!Attachments = strAtch
Next
Else
rst!Attachments = "No Attachments"
End If
'rst!Count = cMail.Attachments.Count
rst!Body = cMail.Body
rst!HTMLBody = cMail.HTMLBody
rst!Importance = cMail.Importance
rst!Size = cMail.Size
rst!CreationTime = cMail.CreationTime
rst!ReceivedTime = cMail.ReceivedTime
rst!ExpiryTime = cMail.ExpiryTime
'rst!EmailLocation = ofProp.Name
rst.Update
'End If
End If
Next i
End If
End Sub
Sub ProcessSubFolders(objItemsR As Outlook.Items, OfR As Outlook.MAPIFolder)
'Code for processing subfolders
' Set up Outlook objects.
Dim ofSubR As Outlook.MAPIFolder
'Set info and call GetMailProp code.
GetMailProp objItemsR, OfR
'Set info and call ProcessSubFolders. Recursive.
For Each ofSubR In OfR.Folders
Set objItemsR = ofSubR.Items
ProcessSubFolders objItemsR, ofSubR
Next
End Sub
We need to pull the senders email address currently it pulls the persons name on occasion it will identify an email but that is very limited (is it to do with the SMTP address?)
In the code you are getting the Sender property, but it is not a scalar property. it returns an instance of the an AddressEntry object that corresponds to the user of the account from which the MailItem is sent. Instead, you need to use the Address property of the AddressEntry class to get a string representing the email address.
In case of Exchange accounts you may use the AddressEntry.GetExchangeUser method which returns an ExchangeUser object that represents the AddressEntry if the AddressEntry belongs to an Exchange AddressList object such as the Global Address List (GAL) and corresponds to an Exchange user. Then you may get the ExchangeUser.PrimarySmtpAddress property value which is a string representing the primary Simple Mail Transfer Protocol (SMTP) address for the ExchangeUser. Returns an empty string if this property has not been implemented or does not exist for the ExchangeUser object.
In cases when you need to convert Ex-like addresses to SMTP ones you may find the HowTo: Convert Exchange-based email address into SMTP email address article helpful.
Once it has imported the emails can it move them to a folder called imported.
Use the Move method available for all Outlook items.
I want to create Visual Basic scrip to create calendar event/invitation.
Script is working perfectly, when only one account is registered in outlook, and event is created OK for this single calendar (account).
PROBLEM:
I have two accounts registered in my outlook. One of the accounts is company-managed (let's call it FIRST). I have also manually created account (let's call it SECOND).
The problem is when I want to create event "on behalf" of SECOND calendar registered manually. I've already set SECOND account as primary account in outlook with:
Outlook->File->Account Settings->Account Setting...->Email Tab->Set as default.
When I'm using (almost) identical code as below to create Outlook email object, script is working perfectly fine, and field "Sender" in the message is populated with correct SECOND account name.
Picture: Email outlook object created, with SENDER populated with correct SECOND account
I've tried to set property: objAppointmentItem.SendUsingAccount = myAccount , with the SECOND account, but then Sender field is left empty, and you can't select account from combo. When I'm sending it it ANYWAY, then it is send to correct recipients, but is NOT send to my SECOND calendar (desired), and invitation/event is visible in my FIRST calendar, which I DON'T want to use anymore.
Picture: Outlook event object with FROM field empty, no selection possible
When I'm NOT setting property: objAppointmentItem.SendUsingAccount = myAccount , event object is created, but is assigned with FIRST account, despite SECOND is set as default.
Picture: Event created with wrong sender, and NO SELECTION possible for SECOND account
When I create invitation with double-click on calendar itself (SECOND account calendar), then invitation is created with correct SECOND account populated in SENDER field, (still no option to select other account - but no need, as is correct :) )
Sub OutOfOfficeEvent()
Dim oAccount As Outlook.Account
Dim myAccount As Outlook.Account
'try to find PERSONAL account. If failed, then send with last avail on the list Application.Session.Accounts
For Each oAccount In Application.Session.Accounts
Set myAccount = oAccount
If InStr(UCase(oAccount.DisplayName), "PERSONAL.COM") Then
Exit For
End If
Next
Dim objOutlookApplication As Outlook.Application
Dim objAppointmentItem As Outlook.AppointmentItem
Dim objRecipient As Recipient
Dim objRecipients As Recipients
Set objOutlookApplication = CreateObject("Outlook.Application")
Set objAppointmentItem = objOutlookApplication.CreateItem(olAppointmentItem)
'###############################################
'####### NOT working for event/invitation
'####### Working OK for email object creation
'###############################################
objAppointmentItem.SendUsingAccount = myAccount
'###############################################
objAppointmentItem.Display
Set objRecipients = objAppointmentItem.Recipients
Set objRecipient = objAppointmentItem.Recipients.Add("somebody1#PERSONAL.COM")
Set objRecipient = objAppointmentItem.Recipients.Add("somebody2#PERSONAL.COM")
objRecipient.Type = olRequired
For Each objRecipient In objAppointmentItem.Recipients
objRecipient.Resolve
Next
Dim DateStart As Date
Dim DateEnd As Date
DateStart = DateTime.DateAdd("d", 0, DateTime.DateAdd("h", 1, DateTime.DateAdd("s", -Second(Now()), DateTime.DateAdd("n", -Minute(Now()), Now()))))
DateEnd = DateTime.DateAdd("h", 1, DateStart)
With objAppointmentItem
.MeetingStatus = olMeeting
.Subject = "[OOO] " & strUser
.Start = DateStart
.End = DateEnd
.AllDayEvent = False
.ReminderSet = False
.BusyStatus = olFree
.ResponseRequested = False
.Location = ""
.Body = "Some body content"
End With
objAppointmentItem.Display
Set objOutlookApplication = Nothing
End Sub
There are several ways of creating new items in Outlook. See How To: Create a new Outlook Appointment item for more information.
If you have two accounts configured in Outlook you need to get the right calendar folder and then add a new calendar entry there. To get this done you can use the GetDefaultFolder method of the Store class which returns a Folder object that represents the default folder in the store and that is of the type specified by the FolderType argument. This method is similar to the GetDefaultFolder method of the NameSpace object. The difference is that this method gets the default folder on the delivery store that is associated with the account, whereas NameSpace.GetDefaultFolder returns the default folder on the default store for the current profile. So, you may get the right store and add the new calendar entry.
The NameSpace.Stores property returns a Stores collection object that represents all the Store objects in the current profile.
Sub EnumerateFoldersInStores()
Dim colStores As Outlook.Stores
Dim oStore As Outlook.Store
Dim oCalendar As Outlook.Folder
On Error Resume Next
Set colStores = Application.Session.Stores
For Each oStore In colStores
Set oCalendar = oStore.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)
Debug.Print (oCalendar.FolderPath)
Next
End Sub
I had the same problem and with above suggestion and some more Google, I found the total solution:
Dim myAI As Outlook.AppointmentItem
myAI = Nothing
Dim oStore As Outlook.Store
For Each oStore In colStores
Dim oCalendar As Outlook.Folder
Set oCalendar = oStore.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)
If LCase(oCalendar.Description) = "<accountname>" Then
Set myAI = oCalendar.Items.Add(Outlook.OlItemType.olAppointmentItem)
Exit For
End If
Next
In VBA scripting ,I am trying to write a Sub Function which has the following signature
Sub(taskName As String , myGroup As String, myFile As String ,myPer As String, RelatedTasks() As String )
Dim olApp As Outlook.Application
Dim m As Outlook.MailItem
Set olApp = New Outlook.Application
Set m = olApp.CreateItem(olMailItem)
With m
.display
.To = "somewhere#someplace.com"
.Subject = "Test Events"
.HTMLBody/.body = ...
End Sub
Email Body is as follows:
Hello All,
Please find the following information.
TASK: taskName
RELATED TASK:RelatedTasks()
FILE : myFile
PERSON : myPer
In the Sub function , the pattern to the left of colon is always constant.And the right side will change based on the inputs to the function.
For that I am reading the Template.htm which contains the required signature.
Template.htm contains:
Hello All,
Please find the following information.
TASK: {{mytask}}
RELATED TASK:{{myRelatedTasks}}
FILE : {{myFile}}
PERSON : {{myPerson}}
In VBA code,I am replacing all the fields.
The issue that I am facing is {{mytask}} and {{related tasks}} also should have a HTML reference. I have succeeded in adding the link to mytask .Clicking on the mytask in the mail will jump to the respective weblink.
<a href = "www.something.com&id ={{taskID}}>
{{mytask}}.....<a href = "www.xxx.com&id={{}}>{{myRelatedTasks}}
but having trouble in adding the same to Related tasks since it is an array.
My VBA code :
Option Explicit
Sub CreateNewMail()
Dim olApp As Outlook.Application
Dim m As Outlook.MailItem
Dim sigPath As String, sigText As String
Dim fso As Scripting.FileSystemObject
Dim ts As Scripting.TextStream
Dim t As String
Dim r(5) As Variant
t = "233444:dshfjhdjfdhjfhjdhfjdhfjd"
r(0) = "122343:dsjdhfjhfjdh"
r(1) = "323243:jfjfghfjhjddj"
r(2) = "834783:gffghjkjkgjkj"
Set olApp = New Outlook.Application
Set m = olApp.CreateItem(olMailItem)
sigPath = "C:\Users\Pavan-Kumar\Desktop\vbs\TestEvents.htm"
Set fso = New Scripting.FileSystemObject
Set ts = fso.OpenTextFile(sigPath)
sigText = ts.ReadAll
ts.Close
Set fso = Nothing
sigText = Replace(sigText, "{{mytask}}", t)
sigText = Replace(sigText, "{{myRelatedTasks}}", Join(r, "<br>"))
With m
.display
.To = "somewhere#someplace.com"
.Subject = "Test Events"
.HTMLBody = sigText
End With
End Sub
And also when I am joining the related tasks , I want them to come one below another with indentation. I tried it with giving "\t" as the delimiter with no success.
My current O/P in outlook mail:
Here is what I did to solve the same issue:
Write an email with exactly the format you want
In the email, use something unique for the fields, like {{recipient name}}
Save the email as HTML. This is now your template for the email body. You might keep several different templates for different situations.
In VBA, open the appropriate template file and read the whole thing into a string.
Using the VBA command Replace, fill in your fields. For example strHTMLTemplate = Replace(strHTMLTemplate, "{{recipient name}}", "Jane Doe")
Assign the final string to .htmlBody
For the RelatedTasks, it looks like you just want them to be on a single row. In that case, just make a "field" in your template, {{RelatedTasks}} and then do a replace like so strHTMLTemplate = Replace(strHTMLTemplate, "{{RelatedTasks}}", Join(RelatedTasks, ", ")).
If you want to get fancy, you can write functions that converts arrays of strings into html lists or tables
[EDIT] This problem does not appear to exist in C#. See reworked code at the bottom.
This has baffled me for two days now and has finally led me to making my first post on here.
I am coding in the visual basic editor of Excel 2007.
I am using the Outlook 2007 object library, from Excel 2007, not Outlook. Not sure if this matters.
I'm writing a program that will run periodically on a mail folder and parse out important information from emails as they arrive. The emails in question look like plain text, but are identified by the VBA Locals window as being olFormatHTML! To test this, I click "reply" for one of the emails and then attempt to paste an Excel range into the body of the email, and Outlook gives me a popup (Compatibility Checker) that gives me the option to "switch to HTML". Looks like plaintext. Further, opening the message, clicking "Other Actions" --> Encoding yields Unicode (UTF-8). So why in the world, when I expand this MailItem object in the Locals window, does Excel think it is an HTML email?
This MailItem's .Body is empty, and this MailItem's .HTMLBody does not contain the actual contents of the email, which are nonempty when viewed through Outlook. Here's what the HTMLBody value is:
"<html xmlns:o="urn:schemas-microsoft-com:office:office" xmlns:w="urn:schemas-microsoft-com:office:word" xmlns:m="http://schemas.microsoft.com/office/2004/12/omml" xmlns="http://www.w3.org/TR/REC-html40"><head><meta name=ProgId content=Word.Document><met"
Code to create Outlook application object, navigate to desired folder and pass MailItem object to the parser (skip if you're familiar with this part):
' Navigate to desired folder and pass information to text analyzer.
Sub AccessInbox(timeStamp As Date)
Dim olApp As Outlook.Application
Dim objNamespace As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Dim sharedFolder As Outlook.MAPIFolder
Set olApp = New Outlook.Application
Set objNamespace = olApp.GetNamespace("MAPI")
' Explicitly went through hierarchy since I'll be using with a shared Mailbox eventually.
Set objMailbox = objNamespace.Folders("Mailbox - My Name")
Set objFolder = objMailbox.Folders("Inbox")
Set sharedFolder = objFolder.Folders("Folder With Stuff")
'mostly irrelevant, see ParseEmailText code below this
Dim emailTimeStamp As Date
For Each Item In sharedFolder.Items
' Inbox can contain other kinds of objects than MailItem.
If TypeOf Item Is MailItem Then
Dim thisEmail As Object
Set thisEmail = olApp.CreateItem(MailItem)
thisEmail = Item
' Check to see if email has already been analyzed.
emailTimeStamp = thisEmail.ReceivedTime
If emailTimeStamp > timeStamp Then
' Send to email text analyzxer.
ParseEmailText thisEmail
Else
Exit For
End If
End If
Next
End Sub
Code to parse email body:
Sub ParseEmailText(email As Outlook.MailItem)
emBody = email.Body
' This is the part where I wish I could just access the email's body, but it is empty.
End Sub
[EDIT] I reworked this basic code in C# and the MailItem.Body is NOT blank anymore. In fact it works exactly as expected. Any ideas why VBA sucks so much?
class Parser
{
//Outlook variables
Microsoft.Office.Interop.Outlook.Application app = null;
Microsoft.Office.Interop.Outlook._NameSpace ns = null;
Microsoft.Office.Interop.Outlook.MailItem item = null;
Microsoft.Office.Interop.Outlook.MAPIFolder inboxFolder = null;
Microsoft.Office.Interop.Outlook.MAPIFolder atFolder = null;
public Parser()
{
}
public void ParseInbox()
{
//open outlook
//Access Outlook (only need to do this once)
app = new Microsoft.Office.Interop.Outlook.Application();
ns = app.GetNamespace("MAPI"); //Returns a NameSpace object of the specified type. The only supported name space type is "MAPI".
ns.Logon(null, null, false, false); //Namespace.Logon method: Logs the user on to MAPI, obtaining a MAPI session.
inboxFolder = ns.GetDefaultFolder(Microsoft.Office.Interop.Outlook.OlDefaultFolders.olFolderInbox);
atFolder = inboxFolder.Folders["Folder With Stuff"];
for (int i = atFolder.Items.Count; i > 0; i--)
{
item = (Microsoft.Office.Interop.Outlook.MailItem)atFolder.Items[i];
string emailText = item.Body;
}
}
}
You need to use the Set keyword when setting a reference to an object. This line in your code creates a new email object (which is using your default setting of HTML email):
Set thisEmail = olApp.CreateItem(MailItem)
And then this line of code isn't using the Set keyword:
thisEmail = Item
So your variable isn't referncing the object you think but the new email.
Try using:
Set thisEmail = Item
Or, instead, replace both of these lines:
Set thisEmail = olApp.CreateItem(MailItem)
thisEmail = Item
With this line:
Set thisEmail = Item
I have created a custom access database of contacts. I would like to connect Outlook to the database, so that every time a user receives an e-mail, an action is triggered that searches the access database to see if that contact exists (based on the e-mail address I guess). If the contact doesn't exist, it offers to automatically add the contact to the database using information from the e-mail, and then add the contents of the e-mail as an information note to that contact. If the contact does exist, it automatically adds the content of the e-mail as an information note to the existing contact.
Can anyone guide me on how I could set such a system up? I am used to developing in MS Access with VBA, but I'm not used to developing in Outlook with VBA, so I'm not sure where to begin.
Any help would be much appreciated.
It is a while since I tested this, but it is possible to use Outlook events.
For this example you will need a Class Module called clsOlMail with this code:
'Requires reference to the Microsoft Outlook x.x Object Library
Dim WithEvents conItems As Outlook.Items
Private Sub Class_Initialize()
Set oApp = Outlook.Application
Set oNS = oApp.GetNamespace("MAPI")
Set conFolder = oNS.GetDefaultFolder(olFolderSentMail)
Set conItems = conFolder.Items
End Sub
Private Sub Class_Terminate()
Set conItems = Nothing
Set conFolder = Nothing
Set oNS = Nothing
Set oApp = Nothing
End Sub
Sub ConItems_ItemAdd(ByVal Item As Object)
Dim frm As Form
Set frm = Forms!frmEmailDetails
frm.txtSenderName = Item.SenderName
frm.txtSentOn = Item.SentOn
frm.txtTo = Item.To
frm.txtCreationTime = Item.CreationTime
frm.txtBCC = Item.BCC
frm.txtCC = Item.CC
frm.txtSentOnBehalfOfName = Item.SentOnBehalfOfName
frm.txtSubject = Item.Subject
frm.txtBody = Item.Body
End Sub
You will also need a form called frmEmailDetails with these textboxes:
txtSenderName,
txtSentOn,
txtTo,
txtCreationTime,
txtBCC,
txtCC,
txtSentOnBehalfOfName,
txtSubject,
txtBody
And this code:
Private oEvent As clsOLMail
'Requires reference to Microsoft Outlook x.x Object Library
Public oApp As Outlook.Application
Public oNS As Outlook.NameSpace
Public conFolder As Outlook.MAPIFolder
Private Sub Form_Open(Cancel As Integer)
Set oEvent = New clsOlMail
End Sub
Open the form and send an email through Outlook, you can use one of the examples shown above. The form fields should fill with the relevant details from the sent email. You are likely to get an Outlook security warning.