Outlook+vba
I'm using this script to search contact and get its email.
Using Outlook local contact folder (now its name is People I think).
Public Sub ShowContactEmail()
Dim myContacts As Folder
Dim myfilter As String
Dim filteredItems As Outlook.Items
Dim myName As String
myName = "John Doe"
Set myContacts = Application.Session.GetDefaultFolder(olFolderContacts)
Set filteredItems = myContacts.Items
myfilter = "[FirstName] = " & myName & " Or [LastName] = " & myName & " Or [FullName] = " & myName
For Each myItem In filteredItems.Restrict(myfilter)
If (myItem.Class = olContact) Then
Debug.Print myItem.Email1Address
End If
Next
End Sub
It works BUT only if name is exactly as in contact folder.
If I look for "Doe" won't find anything.
How to do a partial search? Try to use "like" and "wildcarts" here but not success. VBA noob.
Also not sure if I have to search in FirstName, Lastname or FullName. This PC is used by several people and not always input new contact details as I want.
Thanks
If I understand microsoft docs correctly you can use char(32) as a 'wildcard' in your search
When matching string properties, you can use either a pair of single quotes ('), or a pair of double quotes ("), to delimit a string that is part of the filter. Typically in VBA Chr(34) function is used which stands for double quotes. For example:
myfilter = "[FirstName] = " & Chr(34) & myName & Chr(34) & " Or [LastName] = " & Chr(34) & myName & Chr(34) & " Or [FullName] = " & Chr(34) & myName & Chr(34)
Read more about that in the Filtering Items Using a String Comparison article.
If you are just trying to resolve a name, try Application.Session.CreateRecipient("John Doe") / Recipient.Resolve.
Related
I often need a search for all emails of a specific day. In order not to change the criteria of a search folder every time, I wrote a macro which creates a suitable search folder after asking for a date and displaying this folder.
Works fine, but whereas the search folder created the manual way within Outlook only lists the mails of this day, the programmed version also displays appointments of calendars of colleagues who shared their calendars with me - appointments and meetings which don't relate to me at all but were sent on that specific day.
The second thing, but a not important one is, that when displaying the properties of the created folder in Outlook the button for changing the criteria is disabled.
I think I need some additional filter criteria for method AdvancedSearch, but which ones?
At the moment, my code is as follows:
Sub CreateSearchFolderForDate()
'Creates a search folder for a specific date. Only the primarey exchange mailbox will be considered
'(no offline folders, no shared folders).
'The folder is displayed afterwards
Dim oSearch As Search
Dim oSearchFolder As Object
Dim strScope As String
Dim strFilter As String
Dim strDate1 As String
Dim strDate2 As String
Dim strInput As String
varInput = InputBox("Date?", "Create search order for a specific date", Date)
If Not IsDate(varInput) Then
Exit Sub
End If
'Delete existing folder first, otherwise there is a runtime error
Set oSearchFolder = GetSearchFolderByName("Mails for day X")
If Not oSearchFolder Is Nothing Then
oSearchFolder.Delete
End If
strScope = "'" & Application.Session.GetDefaultFolder(olFolderInbox).Parent.FolderPath & "'"
strFilter = "urn:schemas:mailheader:date >= '" & CDate(varInput) & "' AND urn:schemas:mailheader:date < '" & CDate(varInput) + 1 & "'"
Set oSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strFilter, SearchSubFolders:=True, Tag:="Mails of a specific date")
oSearch.Save ("Mails for day X")
Set oSearchFolder = GetSearchFolderByName("Mails for day X")
oSearchFolder.Display
End Sub
Function GetSearchFolderByName(strSearchFolderName As String) As Object
'Returns the search folder with the display name specified. Only the primarey exchange mailbox will be considered
'(no offline folders, no shared folders).
Dim oStore As Outlook.Store
Dim oFolder As Outlook.folder
On Error Resume Next
Set GetSearchFolderByName = Nothing
For Each oStore In Application.Session.Stores
If oStore.ExchangeStoreType = olPrimaryExchangeMailbox Then
For Each oFolder In oStore.GetSearchFolders
If oFolder.Name = strSearchFolderName Then
Set GetSearchFolderByName = oFolder
Exit Function
End If
Next
End If
Next
End Function
My idea was to use '''urn:schemas:calendar:dtstart'' as additional AND as for "normal" emails that should be empty and messed around a little bit with it - but either it had no effect or it resulted in a list containing only the undesired elements and no "normal" mails at all.
Attempts like IS NULL or IS NOT NULL in the filter caused VBA runtime errors.
In column "folder" the created search folder displays either the folder/subfolder my mails are stored in or for the unwanted entries a certain common part like Doe, Jane common_part and Doe, John common_part. But I didn't find a property which I could use as part of my filter ('''AND property NOT LIKE %common_part%''').
Any hint would be very much appreciated.
Regards,
Bootes
Update 2023-02-08: Before refactoring my problem using the hints and answers by #niton (thanks a lot for the patience) I will start a few more trys with AdvancedSearch, based on an analysis of a manually created search folder using the Redemption-Tool as developed by #Dmitry Streblechenko and described in his posting in How to get a search folder criteria in Outlook. The tool provided the following SQL-Statement:
((NOT (MessageClass LIKE 'IPM.Appointment%')) AND (NOT (MessageClass LIKE 'IPM.Contact%')) AND (NOT (MessageClass LIKE 'IPM.DistList%')) AND
(NOT (MessageClass LIKE 'IPM.Activity%')) AND
(NOT (MessageClass LIKE 'IPM.StickyNote%')) AND (NOT (MessageClass = 'IPM.Task'))
AND (NOT (MessageClass LIKE 'IPM.Task.%'))) AND
((("http://schemas.microsoft.com/mapi/proptag/0x0E090102" <> EF0000004B1E3AD5164F3F459BFE6A913D00E89042800000')
AND ("http://schemas.microsoft.com/mapi/proptag/0x0E090102" <> EF0000004B1E3AD5164F3F459BFE6A913D00E89022800000'))
AND ((SentOn < '2022-12-20') AND (SentOn >= '2022-12-19')))
I tried to translate this into VBA, but had no real success: If I use just the active lines, there is no effect at all, if I add the last two ones (formatted as comments below), I get error "Runtime error -2147023281 (8007064f) - Error during execution of operation" (re-translated from German to English):
strF = "urn:schemas:mailheader:date >= '" & CDate(strInput) & "' AND urn:schemas:mailheader:date < '" & CDate(strInput) + 1 & "' AND "
strF = strF & "NOT (urn:schemas:mailheader:content-class LIKE 'IPM.Appointment%') AND NOT (urn:schemas:mailheader:content-class LIKE 'IPM.Contact%') AND "
strF = strF & "NOT (urn:schemas:mailheader:content-class LIKE 'IPM.DistList%') AND NOT (urn:schemas:mailheader:content-class LIKE 'IPM.Activity%') AND "
strF = strF & "NOT (urn:schemas:mailheader:content-class LIKE 'IPM.StickyNote%') AND NOT (urn:schemas:mailheader:content-class = 'IPM.Task') AND "
strF = strF & "NOT (urn:schemas:mailheader:content-class LIKE 'IPM.Task.%')" ' AND "
'strF = strF & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0E090102" & Chr(34) & " <> 'EF0000004B1E3AD5164F3F459BFE6A913D00E89042800000'" ' AND "
'strF = strF & "(" & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0E090102" & Chr(34) & " <> 'EF0000004B1E3AD5164F3F459BFE6A913D00E89022800000')) AND "
The second approach could be the folder of the item as the unwanted ones are listed in column "In folder" with the folder name containing the a common part that is not in the folder name of the wanted items.
You can limit the search to the inbox.
strScope = "'" & Application.Session.GetDefaultFolder(olFolderInbox).folderPath & "'"
Advanced search is less capable than say .Restrict.
Delete items in Outlook by 'Type' or 'Message Class'
set restrictedItems = olSearchOlFolder.items.Restrict(" #SQL=""http://schemas.microsoft.com/mapi/proptag/0x001A001F"" LIKE 'IPM.Schedule.Meeting.%' ")
how to apply filter only on outlook messages using vba
oFilter2 = "[MessageClass] = 'IPM.Note'"
This is a theoretical implementation of "urn:schemas:mailheader:content-class", that may be applicable, from https://learn.microsoft.com/en-us/previous-versions/office/developer/exchange-server-2007/aa579702(v=exchg.80)
Private Sub AdvSearch_URN_Test()
Dim strSearch As String
Dim strDASLFilter As String
Dim strScope As String
Dim objSearch As Search
Dim strDASLFilter_option As String
Dim fldrNm As String
strScope = "'" & Session.GetDefaultFolder(olFolderInbox).Parent.folderPath & "'"
Debug.Print strScope
' https://learn.microsoft.com/en-us/previous-versions/office/developer/exchange-server-2007/aa579702(v=exchg.80)
' **** most options do nothing ****
' displayto & fromemail are functional
' search by displayto
strSearch = "to display name"
strDASLFilter_option = "displayto"
' These fail
'strDASLFilter_option = "sender" 'search by Sender
'strDASLFilter_option = "sendername" 'search by senderName
'strDASLFilter_option = "senderemail" 'search by SenderEmail
' search by content-class
' *** This fails ***
strSearch = "IPM.Note"
strDASLFilter_option = "content-class"
strDASLFilter = "urn:schemas:httpmail:" & strDASLFilter_option & " LIKE '%" & strSearch & "%'"
Debug.Print strDASLFilter
Set objSearch = AdvancedSearch(Scope:=strScope, filter:=strDASLFilter, SearchSubFolders:=True, Tag:="SearchFolder")
'Save the search results to a searchfolder
fldrNm = strDASLFilter_option & " " & strSearch
Debug.Print fldrNm
objSearch.Save fldrNm
Debug.Print fldrNm & " saved."
End Sub
I have problem running this code. It gives me Syntax error (missing operator) in query expression
Function SearchCriteria()
Dim class,StateProvince,strAcademicYear As As String
Dim task, strCriteria As String
If isNull(Forms!frmStudentList!cboClass) Then
Class = "[Class] LIKE '*' "
Else
Class = [Class] = " & Forms!frmStudentList!cboClass
End If
If isNull(Forms!frmStudentList!cboStateProvince) Then
StateProvince = "[StateProvince] LIKE '*' "
Else
StateProvince = [StateProvince] = " &
Forms!frmStudentList!cboStateProvince
End If
If isNull(Forms!frmStudentList!cboAcademicYear) Then
StrAcademicYear = "[AcademicYear] LIKE '*' "
Else
StrAcademicYear = [AcademicYear] = '" &
Forms!frmStudentList!cboAcademicYear & "'"
End If
strCriteria = Class & "AND" & StateProvince & "AND" & StrAcademicYear
task = "SELECT * FROM QryStudentSearch WHERE & Criteria
Forms!frmStudentList.RecordSource = task
Forms!frmStudentList.Requery
End Function
There are quite a few problems with this piece of code.
Firstly, most of your variables aren't explicitly declared as being of a type, so default to being Variant.
Next, Class is a reserved word in Access, and will probably cause you problems.
If a control has no choice made, you are using LIKE '*' to select data. There is no need to do this, as by applying no filter means that all records will be returned anyway.
As it doesn't return a value, you can create this as a Sub rather than a Function.
The main problem is with how you are concatenating the different parts together.
I would rewrite the code as:
Sub sSearch()
Dim strSearch As String
If Not IsNull(Forms!frmStudentList!cboClass) Then
strSearch = strSearch & " AND [Class]='" & Forms!frmStudentList!cboClass & "' "
End If
If Not IsNull(Forms!frmStudentList!cboStateProvince) Then
strSearch = strSearch & " AND [StateProvince]='" & Forms!frmStudentList!cboStateProvince & "' "
End If
If Not IsNull(Forms!frmStudentList!cboAcademicYear) Then
strSearch = strSearch & " AND [AcademicYear]='" & Forms!frmStudentList!cboAcademicYear & "' "
End If
If Left(strSearch, 4) = " AND" Then
strSearch = "WHERE " & Mid(strSearch, 6)
End If
strSearch = "SELECT * FROM qryStudentSearch " & strSearch
Forms!frmStudentList.RecordSource = strSearch
Forms!frmStudentList.Requery
End Sub
In each case, I am assuming that the bound column of each combo box is text, hence the need to use single quotes around the data. If the bound column is numeric, then the single quotes can be removed.
Regards,
I got it to just make a list of everything, but I need to do some grouping. my idea was to get a list of addresses, then as I loop through those addresses, filter another query with the information I want to display. If I do that, I don't get an error, but it hangs the program. I'm assuming it's a problem with the loop, but I'm not sure how. Any suggestions?
Public Function getActionItems(strID As String, strType As String) As String
Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
Dim qdfAddress As DAO.QueryDef
Dim rst As DAO.Recordset
Dim rstAddress As DAO.Recordset
Dim s As String
Set dbs = CurrentDb
'Get the parameter query
Set qdf = dbs.QueryDefs("qryActionItems")
Set qdfAddress = dbs.QueryDefs("qryActionItemsAddresses")
'get all records
Set rst = qdf.OpenRecordset()
Set rstAddress = qdfAddress.OpenRecordset()
'get all records with the submisison number
rstAddress.filter = "submission_number=" & strID
Set rstAddressFiltered = rstAddress.OpenRecordset
'cycle through the addresses
If Not rstAddressFiltered.EOF Then
rstAddressFiltered.MoveFirst
s = s + "<strong>" & rstAddressFiltered!Address & "</strong>" & vbLf & "<ol>"
Do
'filter for the address
rst.filter = "submission_number=" & strID & "AND Address=" & """ & rstAddressFiltered!Address & """
Set rstFiltered = rst.OpenRecordset
'cycle through the records with the address
If Not rstFiltered.EOF Then
rstFiltered.MoveFirst
Do
s = s + vbTab & "<li>" & rstFiltered!Address & " - " & rstFiltered!Notes & " - " & rstFiltered!Due_date & "</li>" & vbLf
rstFiltered.MoveNext
Loop Until rstFiltered.EOF
End If
Loop Until rstAddressFiltered.EOF
s = s + "</ol>"
End If
End Function
Edit: I think it may be that I missed the .movenext, but I haven’t had a chance to try it.
The main query has
submission_number, type, address, notes
I'm trying to get something like
123 main st
Foo bar
Bar foo
126 main st
Notes
When I run the query I won't know what or how many addresses I have. So I thought I would use query1 to grab the addresses, then use the addresses in query1 to filter query2, printing those results.
If you see a better approach, I'm open!
Filter criteria has syntax errors. Need a space in front of AND. Quote mark delimiters are wrong. Use apostrophe instead of trying to double up quote mark.
rst.filter = "submission_number=" & strID & " AND Address='" & rstAddressFiltered!Address & "'"
I would like to create a macro to perform an "Advanced Search" on tasks subject and optionally tasks body. For instance search for "#Cris"
I have copied and modified this code from an example for Excel but it doesnt run. Runtime Error. Appreciate any assistance
Sub AdvancedSearchComplete()
Dim rsts As Outlook.Results
Dim i As Integer
Dim strF As String
Dim strS As String
strS = "Tasks"
StrName = InputBox("Search String?")
strF = InStr(LCase("urn:schemas:tasks:subject"), StrName)
Set sch = Application.AdvancedSearch(strS, strF, , "Search1")
End Sub
You need to specify a valid scope and search criteria. The scope of the search is the folder path of a folder, not a folder name. It is recommended that the folder path is enclosed within single quotes. Otherwise, the search might not return correct results if the folder path contains special characters including Unicode characters. To specify multiple folder paths, enclose each folder path in single quotes and separate the single quoted folder paths with a comma.
The Filter parameter can be any valid DASL query. For additional information on DASL queries, see Filtering Items.
Note, you can use the Chr Function to represent any character in the search criteria.
Sub TestSearchForMultipleFolders()
Dim Scope As String
Dim Filter As String
Dim MySearch As Outlook.Search
Dim MyTable As Outlook.Table
Dim nextRow As Outlook.Row
m_SearchComplete = False
'Establish scope for multiple folders
Scope = "'" & Application.Session.GetDefaultFolder( _
olFolderInbox).FolderPath _
& "','" & Application.Session.GetDefaultFolder( _
olFolderSentMail).FolderPath & "'"
'Establish filter
If Application.Session.DefaultStore.IsInstantSearchEnabled Then
Filter = Chr(34) & "urn:schemas:httpmail:subject" _
& Chr(34) & " ci_phrasematch 'Office'"
Else
Filter = Chr(34) & "urn:schemas:httpmail:subject" _
& Chr(34) & " like '%Office%'"
End If
Set MySearch = Application.AdvancedSearch(Scope, Filter, True, "MySearch")
While m_SearchComplete <> True
DoEvents
Wend
Set MyTable = MySearch.GetTable
Do Until MyTable.EndOfTable
Set nextRow = MyTable.GetNextRow()
Debug.Print nextRow("Subject")
Loop
End Sub
Also you may find the Advanced search in Outlook programmatically: C#, VB.NET article helpful.
Ok, this is what I got to work.
When starting the macro:
It Asks user to enter string
Performs and advance search and search for string in subject (including special characters like #cris)
Creates search folder to display search results
In case it helps anybody else. I don't know how to create an output like when doing a manual search. But this works for me.
Sub AdvSearchForStr()
On Error GoTo Err_SearchFolderForSender
Dim strFrom As String
Dim strTo As String
Dim strSearch As String
strSearch = InputBox("Enter String to AdvSearch", "Advanced Search")
strTo = "Test"
Dim strDASLFilter As String
strDASLFilter = "urn:schemas:httpmail:subject LIKE '%" & strSearch & "%'"
Debug.Print strDASLFilter
Dim strScope As String
strScope = "'Inbox', 'Sent Items', 'Tasks'"
Dim objSearch As Search
Set objSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strDASLFilter, SearchSubFolders:=True, Tag:="SearchFolder")
'Save the search results to a searchfolder
objSearch.Save (strSearch)
Set objSearch = Nothing
Exit Sub
Err_SearchFolderForSender:
MsgBox "Error # " & Err & " : " & Error(Err)
End Sub
if i have a textbox with contents like "the big brown fox jumped over the lazy dog",
how do i split it and put the contents in a listbox like this:
0,the
1,big
2,brown
3,fox
4,jumped
5,over
6,the
7,lazy
8,dog
PLz help, newbie
You could use the Split() function. Something like this:
Public Function SplitToListBox(ByVal strInput As String) As String
Dim strTemp() As String
Dim intCounter As Integer
Dim strRowsource As String
Const strQuote As String = """"
strTemp() = Split(strInput, " ")
For intCounter = 0 To UBound(strTemp())
If Len(strRowsource) = 0 Then
strRowsource = strQuote & Trim(CStr(intCounter)) & strQuote & "; " & strQuote & strTemp(intCounter) & strQuote
Else
strRowsource = strRowsource & "; " & strQuote & Trim(CStr(intCounter)) & strQuote & "; " & strQuote & strTemp(intCounter) & strQuote
End If
Next intCounter
SplitToListBox = strRowsource
End Function
Now, you'd then need a listbox defined with two columns, and you'd want to set the widths on those columns appropriately (0.5";1" works if you want to see both; 0";1" works if you want the first column to be hidden (though it will be the bound column if you don't change the default properties). You also need to set the RowSourceType property to "Value List".
One caveat:
There's a hard limit on the length of the Rowsource property when it's a Value List. I can't remember the exact number, but it's somewhere upward of 2000 characters. If you need more than that, then I'd suggest you convert the code that creates the list to a custom function. There are instructions on how to do this in the help for combo-/listboxes.