I currently have the following script:
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.Session.GetSelectNamesDialog
objMail.Display 'To display address book
This will open the Global Address list from Outlook.
Now when I single click or double click (doesn't matter) on a contact, I want a messagebox that contains the emailadress of the contact.
You can use the following code to get the selected contacts:
If .Display Then
'Recipients Resolved
'Access Recipients using oDialog.Recipients
End If
For example:
Sub ShowContactsInDialog()
Dim oDialog As SelectNamesDialog
Dim oAL As AddressList
Dim oContacts As Folder
Set oDialog = Application.Session.GetSelectNamesDialog
Set oContacts = _
Application.Session.GetDefaultFolder(olFolderContacts)
'Look for the address list that corresponds with the Contacts folder
For Each oAL In Application.Session.AddressLists
If oAL.GetContactsFolder = oContacts Then
Exit For
End If
Next
With oDialog
'Initialize the dialog box with the address list representing the Contacts folder
.InitialAddressList = oAL
.ShowOnlyInitialAddressList = True
If .Display Then
'Recipients Resolved
'Access Recipients using oDialog.Recipients
End If
End With
End Sub
Related
I have created an extension that extracts some parameters for the email and forwards it to our platform. It's working fine but now I want to make sure that my extension works even in preview mode. We don't have to open an email in order to use an extension.
I couldn't find any configuration to enable the plugin in preview mode.
It seems you need to handle the SelectionChange event of the Explorer class. It is fired when the user selects a different or additional Microsoft Outlook item programmatically or by interacting with the user interface. This event also occurs when the user (either programmatically or via the user interface) clicks or switches to a different folder that contains items, because Outlook automatically selects the first item in that folder. However, this event does not occur if the folder is a file-system folder or if any folder with a current Web view is displayed.
Public WithEvents myOlExp As Outlook.Explorer
Public Sub Initialize_handler()
Set myOlExp = Application.ActiveExplorer
End Sub
Private Sub myOlExp_SelectionChange()
MsgBox myOlExp.Selection.Count & " items selected."
End Sub
The Explorer.Selection property returns a Selection object that contains the item or items that are selected in the explorer window. Here is the sample how you can deal with the Selection object:
Sub GetSelectedItems()
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim mySender As Outlook.AddressEntry
Dim oMail As Outlook.MailItem
Dim oAppt As Outlook.AppointmentItem
Dim oPA As Outlook.PropertyAccessor
Dim strSenderID As String
Const PR_SENT_REPRESENTING_ENTRYID As String = "http://schemas.microsoft.com/mapi/proptag/0x00410102"
Dim MsgTxt As String
Dim x As Long
MsgTxt = "Senders of selected items:"
Set myOlExp = Application.ActiveExplorer
Set myOlSel = myOlExp.Selection
For x = 1 To myOlSel.Count
If myOlSel.Item(x).Class = OlObjectClass.olMail Then
' For mail item, use the SenderName property.
Set oMail = myOlSel.Item(x)
MsgTxt = MsgTxt & oMail.SenderName & ";"
ElseIf myOlSel.Item(x).Class = OlObjectClass.olAppointment Then
' For appointment item, use the Organizer property.
Set oAppt = myOlSel.Item(x)
MsgTxt = MsgTxt & oAppt.Organizer & ";"
Else
' For other items, use the property accessor to get the sender ID,
' then get the address entry to display the sender name.
Set oPA = myOlSel.Item(x).PropertyAccessor
strSenderID = oPA.GetProperty(PR_SENT_REPRESENTING_ENTRYID)
Set mySender = Application.Session.GetAddressEntryFromID(strSenderID)
MsgTxt = MsgTxt & mySender.Name & ";"
End If
Next x
Debug.Print MsgTxt
End Sub
This question already has answers here:
VBScript to send email without running Outlook
(2 answers)
Closed 3 years ago.
I want to select files within Windows Explorer and then by pressing a shortcut (assigned to a VBS-script) to send these files with Outlook (2010).
I found two working code snippets:
Code snippet1 (Creating Email):
Dim objOutl
Set objOutl = CreateObject("Outlook.Application")
Set objMailItem = objOutl.CreateItem(olMailItem)
'comment the next line if you do not want to see the outlook window
objMailItem.Display
strEmailAddr = "test#test.com"
objMailItem.Recipients.Add strEmailAddr
objMailItem.Body = "Hi, this is the body.."
objMailItem.Attachments.Add "C:\test.txt"
'objMailItem.Send
Set objMailItem = nothing
Set objOutl = nothing
Code snippet2 (returning paths of the selected files in Windows Explorer):
Function GetSelectedFiles() 'Returns paths as array of strings
Dim FileList, Window, SelectedItem
'avoid duplicates by storing paths in dictionary keys
Set FileList = CreateObject("Scripting.Dictionary")
With CreateObject("Shell.Application")
For Each Window In .Windows
'skip IE Windows
If InStr(1, Window.FullName, "iexplore.exe", vbTextCompare) = 0 Then
For Each SelectedItem In Window.Document.SelectedItems
FileList(SelectedItem.Path) = Null
'MsgBox SelectedItem.Path
Next
End If
Next
End With
GetSelectedFiles = FileList.Keys 'array of paths
End Function
MsgBox "Click OK after selecting the items", vbOKOnly Or vbInformation, "Select a few items"
Dim SelectedFiles
SelectedFiles = GetSelectedFiles
MsgBox "You selected: " & vbNewLine & vbNewLine & Join(SelectedFiles, vbNewLine), vbOKOnly Or vbInformation, "Selected Items"
How to combine these code snippets to achieve my purpose? I tried to give the SelectedItem.Path a variable to add it to the objMailItem.Attachments.Add but it is not working.
I tried the cdo approach but this issue seems to be more complex. I have an office365-account and the configuration settings seems to differ from VBScript to send email without running Outlook.
Yesss I got it working and it is very cool, I love it :-)
Dim x ,objOutl ,objMailItem ,strEmailAddr
Set objOutl = CreateObject("Outlook.Application")
Set objMailItem = objOutl.CreateItem(olMailItem)
'comment the next line if you do not want to see the outlook window
objMailItem.Display
strEmailAddr = "test#test.com"
objMailItem.Recipients.Add strEmailAddr
objMailItem.Subject = "Test"
objMailItem.Body = "Hi, this is the body.."
'in the next line it will jump in to function "GetSelectedFiles"
x=GetSelectedFiles
'comment out the next three lines for sending directly..
'objMailItem.Send
'Set objMailItem = nothing
'Set objOutl = nothing
Function GetSelectedFiles() 'Returns paths as array of strings
Dim FileList, Window, SelectedItem
'avoid duplicates by storing paths in dictionary keys
Set FileList = CreateObject("Scripting.Dictionary")
With CreateObject("Shell.Application")
For Each Window In .Windows
'skip IE Windows
If InStr(1, Window.FullName, "iexplore.exe", vbTextCompare) = 0 Then
For Each SelectedItem In Window.Document.SelectedItems
FileList(SelectedItem.Path) = Null
x = SelectedItem.Path
'next line is just for debugging..
'msgBox x
'The next line was the solution
objMailItem.Attachments.Add x
Next
End If
Next
End With
GetSelectedFiles = x 'array of paths
End Function
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
I get some items duplicated when I iterate the Inbox of an IMAP folder looking for messages with a particular subject line and sender e-mail address. For instance, in Outlook application I can see just 3 messages passing the filter, but the following script results in 5 messages with one of the messages read 3 times. I have been checking and each duplicated element has different ConversationID even when the subject line and body text is the same. From where those duplicates are coming if I cannot see them in the Outlook panel?
Thanks in advance!
Private Sub GetFromFolder(ofldr)
Dim oItem
Dim oSubFldr
Dim sBadEmail
Dim matches
Dim colMail
Dim i
Dim key
Set colMail = CreateObject("Scripting.Dictionary")
i = 1
' Process all mail items in this folder
For Each oItem In ofldr.Items
If TypeName(oItem) = "MailItem" Then
With oItem
If StrComp(.Subject, g_SubjectLine) = 0 And StrComp(.SenderEmailAddress, g_SystemEmailAddress) = 0 Then
'ProcessQuery .Body
colMail.Add i, oItem
i = i + 1
End If
End With
End If
Next
For Each key In colMail.Keys
ProcessQuery colMail.Item(key).Body
Next
set colMail = Nothing
End Sub
I have rules set up to copy emails containing certain keywords to specific folders and mark as read.
The problem i'm having is when it copies those emails to the folders it marks the original email in the inbox as read, and which can cause me to miss the message.
If i don't mark it as read then when i read it in the Inbox it stays unread in the specific folder.
I cant find any rule properties to accomplish this, anyone have any ideas?
Set the rules to copy to the target folders but not mark as read.
Put this untested code in the ThisOutlookSession module. Assumes the target folders are directly under the Inbox. If buried deeper, add .Folders as necessary.
Option Explicit
' one line for each target folder
Private WithEvents myOlItemsA As Outlook.Items
Private WithEvents myOlItemsB As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' one line for each target folder
Set myOlItemsA = objNS.GetDefaultFolder(olFolderInbox).Folders("targetfoldernameA").Items
Set myOlItemsB = objNS.GetDefaultFolder(olFolderInbox).Folders("targetfoldernameB").Items
End Sub
' one copy of ItemAdd code for each target folder
Private Sub myOlItemsA_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
Msg.Unread = False
End If
ProgramExit:
Set Msg = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Private Sub myOlItemsB_ItemAdd(ByVal item As Object)
' same code as for myOlItemsA
End Sub
Code based on this post Using VBA to read new Outlook Email?
The rules move mail to target folders. The ItemAdd code acts on the items added to the target folders.