Everything I read about MS Outlook says the addressentry.id is unique. but mine don't appear to be.
Here's some code:
Dim anaddressentry As AddressEntry
Dim listuniqueid As String
Dim lastlistunique As String
Dim kount As Integer
lastlistunique = "none"
For kount = 1 To 20
For Each anaddressentry In Session.AddressLists.Item(2).AddressEntries
If anaddressentry.Name = "testcontactgroup" Then
listuniqueid = anaddressentry.ID
If lastlistunique <> "none" Then
If lastlistunique <> listuniqueid Then
Stop
End If
End If
lastlistunique = listuniqueid
End If
Next
Next
It runs the same routine 20 times where it goes through my contacts and looks for something with the name "testcontactgroup" then it gets it's addressentry.id. If this isn't the first time, it compares it with the last addressentry.id it got for that contact.
If they aren't the same, it stops. As I understand it, they should always be the same.
They're close to the same, except for the last few characters.
here are two values I get for the id for the same address entry
00000000FE42AA0A18C71A10E8850B651C2400000300000005000000FF000000180000000000000058D0304A0573A945BD70D6FBA5D114FAC416A000000090
00000000FE42AA0A18C71A10E8850B651C2400000300000005000000FF000000180000000000000058D0304A0573A945BD70D6FBA5D114FAC416A00060209B
Any suggestions?
thanks
bob
That entry id refers to a contact in one of your Contacts folders. It includes (besides a few flags) the email kind (email1, email2, fax, etc.). and the entry id of the corresponding IPM.Contact message (ContactItem object).
You should never directly compare entry ids - that is what Namespace.CompareEntryIDs is for: multiple entry ids can refer to the same object.
Related
Is there a way to search an inbox for a part of a subject line from an email then forward the search results to another email address?
Example:
COMPLETE email comes into inbox, subject line of the email is “This is the subject COMPLETE”. I want any emails with “subject” in the subject line to be forwarded to a different email address.
EDIT: To clarify, the macro should search the subject line for a combination of letters and numbers, always 15 characters long, to the left of COMPLETE.
Also, the macro would not need to be triggered when the COMPLETE email comes into the inbox (ok to be triggered manually). It would need to treat each complete email as a separate “job” to repeat the search and forward for each email with complete in the subject.
I will try to get you started but only you can debug any code as only you have the emails you wish to forward. I have created some emails that match my understanding of your emails but I cannot be sure I have got then perfectly correct.
I do not know how much VBA you know. In general, once you know a statement exists, it is fairly easy to search the web for an explanation. So I will concentrate of explaining what my code is doing.
For the first stage of your macro you need to gather the following information:
abcdefghijklmno Email1 Email2 Email3 . . .
bcdefghijklmnop Email4 Email5 . . .
where “abcdefghijklmno” and “bcdefghijklmnop” are the code for a ‘job’ and Email1 to Email5 are the emails whose subjects include the codes.
For a macro a folder, such as Inbox, is a collection. There are different ways of identifying a particular Email but I think the most convenient way for your requirement is by its position or index within the collection. The first email added to a folder will have an index of 1, the second and index of 2 and so on. If you know about arrays, this will seem familiar. The difference is that with collections you can delete existing items from or add new items in the middle of the collection. Suppose, I have a collection with items A, B, C, E and F which will have indices 1 to 5. I now add item D between items C and E. Items A to C are still items 1 to 3. But D is now item 4, E has become item 5 and F has become item 6. You have the opposite situation when an item is deleted with items further down the collection having their index numbers reduced. This is probably strange but I believe it will become clearer later when it becomes important.
So what we need to create is:
abcdefghijklmno 25 34 70 . . .
bcdefghijklmnop 29 123 . . .
After Option Explicit, which you can look up, the first statement is Type tFamily. VBA comes with a wide variety of data types, for example: Long, Double, String and Boolean. Sometimes these are not enough on their own and we need to combine them into what VBA calls user types and most other languages call structures. You may have heard of classes. Classes are a step up from user types and we do not need their extra functionality or extra complications.
So I have written:
Type tFamily
Code As String
Members As Collection
End Type
Here I have combined a String and a Collection into a larger type which I have named tFamily. The “t” is my standard because I often have difficulty thinking of different names for my types and my variables. This type matches the data I describe above. I have called all the emails with the same code a Family. Within a family, I have a string to hold the code and a collection to hold all the indices.
Further down my code, I have defined an array of families:
Dim Families() As tFamily
This is where I will hold all the information about the email families.
The next important statement is:
Set FldrInbox = Session.Folders("xxx").Folders("Inbox")
You need to replace “xxx” with the name of the shared mailbox.
The first block of code, headed Identify the 'COMPLETE' emails and record their indices in InxsItemComplete scans through all the emails in Inbox and records the index of each email with a subject ending “COMPLETE”. With the example data above, at the end, InxsItemComplete would contain 123 and 70.
The next statement is ReDim Families(1 To InxsItemComplete.Count). InxsItemComplete.Count is the number of complete families. This statement sizes array Families so it can hold this number of families. It is possible to have collections within collection but collections within an array are simpler.
The next block extracts the code from each ‘COMPLETE’ and stores it and the index of the ‘COMPLETE’ email in Families. The code assumes the emails subject is something like:
xxxxxxxxxx abcdefghijklmno spaces COMPLETE
The code sets PosCodeEnd to point before “COMPLETE”. It backs up until it finds a non-space and then extracts the previous 15 characters. This code is then stored in Families(InxF).Code. The index of the email is added to Families(InxF).Members.
The next block again scans through all the emails in Inbox. This time it is looks for emails with subjects that contain a code but do not end with “COMPLETE”. It adds the index of these emails to Families(InxF).Members. These indices are added so these are in ascending sequence. I will explain why this sequence is important when I add the next stage of this macro which forwards the emails.
This is the end of stage 1. All the data needed for forwarding emails has been collected. The remaining block of code outputs the data to the Immediate Window so it can be checked. With my test emails, that output is:
abcdefghijklmno
122 06/10/2019 13:28:38 Introductory text aaa abcdefghijklmno Progress
124 06/10/2019 13:27:35 Introductory text ccccc abcdefghijklmno Progress
126 06/10/2019 13:26:05 Introductory text ccccc abcdefghijklmno Progress
127 06/10/2019 13:24:54 Introductory text aaa abcdefghijklmno COMPLETE
zyxwvutsrqponml
121 06/10/2019 13:29:10 Introductory text bbbbbb zyxwvutsrqponml COMPLETE
123 06/10/2019 13:28:00 Introductory text bbbbbb zyxwvutsrqponml Progress
125 06/10/2019 13:26:38 Introductory text aaa zyxwvutsrqponml Progress
The important part of this data is:
abcdefghijklmno
122
124
126
127
zyxwvutsrqponml
121
123
125
That is the codes and the indices are the recorded data. The received time and subject are to help you identify the referenced emails.
You need to run this macro and check this output for:
Every email with a subject ending “COMPLETE” has been identified.
The code has been correctly extracted.
Every email containing a code has been found and recorded.
The indices are in ascending sequence for each code.
Come back with questions as necessary. However, remember I cannot see your emails so there is a limit to how much I can help with the debugging. Once you confirm that the diagnostic output is correct, I will add the code for stage 2.
Option Explicit
Type tFamily
Code As String
Members As Collection
End Type
Sub FindAndForwardCompleteConversations()
Dim Families() As tFamily
Dim FldrInbox As Folder
Dim InxItemCrnt As Long
Dim InxF As Long ' Index into Families and InxsItemComplete
Dim InxM As Long ' Index into members of current family
Dim InxsItemComplete As New Collection
Dim Placed As Boolean
Dim PosCodeEnd As Long
Dim Subject As String
Set FldrInbox = Session.Folders("xxx").Folders("Inbox")
' Identify the 'COMPLETE' emails and record their indices
For InxItemCrnt = FldrInbox.Items.Count To 1 Step -1
With FldrInbox.Items.Item(InxItemCrnt)
If .Class = olMail Then
If Right$(.Subject, 8) = "COMPLETE" Then
InxsItemComplete.Add InxItemCrnt
End If
End If
End With
Next
ReDim Families(1 To InxsItemComplete.Count)
' Extract code from each "COMPLETE" emails and start families with 'COMPLETE' email
For InxF = 1 To InxsItemComplete.Count
Subject = FldrInbox.Items.Item(InxsItemComplete(InxF)).Subject
PosCodeEnd = Len(Subject) - 8 ' Position to space before COMPLETE
' Position to first non-space character before COMPLETE
Do While Mid$(Subject, PosCodeEnd, 1) = " "
PosCodeEnd = PosCodeEnd - 1
Loop
Families(InxF).Code = Mid$(Subject, PosCodeEnd - 14, 15)
Set Families(InxF).Members = New Collection
Families(InxF).Members.Add InxsItemComplete(InxF)
Next
Set InxsItemComplete = Nothing ' Release memory of collection which is no longer needed
' Identify emails containing the same code as the 'COMPLETE' emails
' and add to the appropriate Family
For InxItemCrnt = FldrInbox.Items.Count To 1 Step -1
With FldrInbox.Items.Item(InxItemCrnt)
If .Class = olMail Then
Placed = False
For InxF = 1 To UBound(Families)
If Right$(.Subject, 8) <> "COMPLETE" And _
InStr(1, .Subject, Families(InxF).Code) <> 0 Then
' Add InxItemCrnt to collection of members for this family
' so that indices are in ascending sequence
For InxM = 1 To Families(InxF).Members.Count
If InxItemCrnt < Families(InxF).Members(InxM) Then
Families(InxF).Members.Add Item:=InxItemCrnt, Before:=InxM
Placed = True
Exit For
End If
Next
If Not Placed Then
Families(InxF).Members.Add Item:=InxItemCrnt
Placed = True
End If
End If
If Placed Then
' Email added to current family so not need to check other families
Exit For
End If
Next
End If
End With
Next
' Output collected information
For InxF = 1 To UBound(Families)
Debug.Print Families(InxF).Code
For InxM = 1 To Families(InxF).Members.Count
InxItemCrnt = Families(InxF).Members(InxM)
With FldrInbox.Items.Item(InxItemCrnt)
Debug.Print " " & InxItemCrnt & " " & .ReceivedTime & " " & .Subject
End With
Next
Next
End Sub
Essentially this includes 3 components.
First is a form, here the user, via a listbox, chooses multiple names.
For example, they highlight the following names.
Jane
John
Bob
They click a button called "btnGenerate" and these three names get entered as seperate records into a table called "NameCriteria" like this:
ID Name
1 Jane
2 John
3 Bob
Along with this, on-click of the button btnGenerate, a report is generated.
What I cannot seem to get working is that on the report, I hope to get a summary of what was selected on the form. I have a textbox on this report which I am trying to get to generate the following result
Jane, John, Bob
OR if there is only one name highlighted when the btnGenerate is clicked, the textbox will only display
Jane
I cannot seem to get this working. In the report, on the textbox, under the textbox's data/control source, I have entered the following code.
=[Forms]![Report]![lstName]
This just leaves the textbox blank. I have also tried referencing the table "NameCriteria" using
=[Table]![NameCriteria]![Name]
and I return #Error in the textbox.
I'd use something along these lines, using ADO, but its been a long day, so there may be simpler solution.
Public Function CONCAT_SQL(strSQL As String) As String
Dim r As ADODB.Recordset
Dim a As Variant
Set r = New ADODB.Recordset
r.Open strSQL, CurrentProject.Connection, 1
a = Split(r.GetString, Chr(13))
ReDim Preserve a(UBound(a) - 1)
CONCAT_SQL = Join(a, ",")
End Function
Called like so,
me.textbox1.value = CONCAT_SQL("Select [Name] from [NameCriteria]")
I have a customers table that is displayed in a datagridview. I would like the user to be able to enter the customers full or partial last name and click a buttom that would then find the first customer that met the match in the text box. As an example: The user types "wil" into the text box and the first record found is for "williams" even though the user is looking for "wilson". The record would be highlighted(selected) and the user could scroll to look at other records and select "wilson" manually (the manual part I can code).
I have searched for hours on the internet and cannot find this type of code. Most of it is filtering or searching every cell and returning every value.
I am currently reworking a project I did with an access database and vba several years ago. I had thought vb.net would be very similar but it is not similar enough for me to modify this code. I'm also going to use a sql database.
The index field is obviously cell(0) and last name is cell(1).
I have found a solution although I did have to modify it. It will do everything I need except one thing. If I type the letter "H" and do a search on last name, it finds the first lastname that has an "H" in the last name but in a different position from the first letter. I need it to go to the first last name that begins with an "H". I have listed my code below.
Dim srch As String
Dim irowindex As Integer
Dim strl As Integer
srch = txtSearch.Text
dgvCustomers.ClearSelection()
For i As Integer = 0 To dgvCustomers.Rows.Count - 1
If dgvCustomers.Rows(i).Cells(0).Value IsNot Nothing Then
If dgvCustomers.Rows(i).Cells(1).Value.ToString.ToUpper.Contains(srch.ToUpper) Then
dgvCustomers.Rows(i).Selected = True
dgvCustomers.RowsDefaultCellStyle.SelectionBackColor = Color.DimGray
irowindex = dgvCustomers.SelectedCells.Item(0).Value
MessageBox.Show(irowindex)
Exit For
End If
End If
Next
End Sub
try this sir.
for each row as datagridviewrow in nameofdatagrid.rows
if row.cells("Lastname").value = txtbox.text then
nameofdatagrid.clearselection()
row.cells("Lastname").selected = true
exit for
end if
next
I think this is your problem? finding lastname match in the datagrid and select it?
hope this will help you :)
Dim srch As String
Dim irowindex As Integer
Dim strl As Integer
srch = txtSearch.Text
dgvCustomers.ClearSelection()
For i As Integer = 0 To dgvCustomers.Rows.Count - 1
If dgvCustomers.Rows(i).Cells(0).Value IsNot Nothing Then
If dgvCustomers.Rows(i).Cells(1).Value.ToString.ToUpper.StartsWith(srch.ToUpper) Then
dgvCustomers.Rows(i).Selected = True
dgvCustomers.RowsDefaultCellStyle.SelectionBackColor = Color.DimGray
irowindex = dgvCustomers.SelectedCells.Item(0).Value
MessageBox.Show(irowindex)
Exit For
End If
End If
Next
I built a sub that iterates over a sheet of business transactions for the day and addresses and attaches PDF receipts for our customers. Some customers work for the same firm, but are treated as different entities so they each receive their own email receipts. Folks from this particular firm are only identifiable as a team by their email handle, which is how I have been matching what receipts go to which email handles for which individuals.
Problem:
The problem I've encountered is that in the contacts master list (holds all of the contact information) the names are listed as first name then last name (I.E. John Snow) and on the occasion one of the external systems that information is pulled from lists the names as Last name then first name (Snow John), which isn't found by my current code. I know I could probably use InStr but to me that's a bit sloppy and the information contained in these receipts are extremely confidential. I'm struggling to come up with an consistent way to find the name regardless in a neat and eloquent way.
Possible solution I thought of was to split the names and store them into an array and then compare the different index places, but that seems inefficient. Any thoughts?
Current Code that is insufficient Note: This is only a small function from the main routine
Private Function IsEmpSameFirm(empName As String, firmEmail As String, firmName As String) As Boolean
'Finds separate employee email and compares to current email to find if same distribution
Dim empFinder As Range, firmFinder As Range
Dim columnCounter As Long
columnCounter = 1
While firmFinder Is Nothing
Set firmFinder = contactsMaster.Columns(columnCounter).Find(firmName)
columnCounter = columnCounter + 1
Wend
Set empFinder = contactsMaster.Rows(firmFinder.Row).Find(empName)
If empFinder Is Nothing Then
IsEmpSameFirm = False
ElseIf empFinder.Offset(0, 1).Value = firmEmail Then
IsEmpSameFirm = True
Else
IsEmpSameFirm = False
End If
End Function
Short answer: It is not possible
Middle answer: This implies a reasoning:
- You loop through your memories to recall which of the 2 gaven "Strings" is a name and which one is a last name. If you wish the PC to do the same, you'd need to "teach" it that -write a DataBase which contains every last name you know and if it's found there then it's a last name-
Long Answer:
What I'd do is split the text in columns, do a filter for each one and then analyze them "manually", this function may help you to split the string
Function RetriveText(InString As String, ChrToDivide, Position As Long)
On Error GoTo Err01RetriveText
RetriveText = Trim(Split(InString, ChrToDivide)(Position - 1))
If 1 = 2 Then '99 If error
Err01RetriveText: RetriveText = "Position " & Position & " is not found in the text " & InString
End If '99 If error
End Function
IE:
A1 =John Smith
B1 =RetriveText(A1," ",1) 'Result: John
C1 =RetriveText(A1," ",2) 'Result: Smith
Edit: Just realized that you are trying to send by email, are they contacts in Outlook? If so, why not to check them there? Try this function
Public Function ResolveDisplayName(sFromName) As Boolean
'----------------------------------------------------------------------------------
' Procedure : ResolveDisplayNameToSMTP
' Author : Sue Mosher - updated by D.Bartrup-Cook to work in Excel late binding.
'-----------------------------------------------------------------------------------
Dim olApp As Object 'Outlook.Application
Dim oRecip As Object 'Outlook.Recipient
Dim oEU As Object 'Outlook.ExchangeUser
Dim oEDL As Object 'Outlook.ExchangeDistributionList
Set olApp = CreateObject("Outlook.Application")
Set oRecip = olApp.Session.CreateRecipient(sFromName)
oRecip.Resolve
If oRecip.Resolved Then
ResolveDisplayName = True
Else
ResolveDisplayName = False
End If
End Function
I have a simple macro that goes through a series of sheets, gathering names based on a data inputted, then puts it all in a nicely formatted Word document. I have most of it figured out, but one bug is annoying me. It has to do with the code that gets the cell phone number based on the name. Here is the function:
Function findCell(namePerson As String) As String
Dim splitName As Variant
Dim lastName As String
Dim firstName As String
splitName = Split(namePerson, " ")
lastName = splitName(UBound(splitName))
ReDim Preserve splitName(UBound(splitName) - 1)
firstName = Join(splitName)
For Each b In Worksheets("IT").Columns(1).Cells
If b.Value = lastName Then
If Sheets("IT").Cells(b.row, 2).Value = firstName Then findCell = Sheets("IT").Cells(b.row, 4).Value
End If
Next
End Function
The cellphone numbers are on its own sheet called "IT". The first column has the last name, the second column has the first name, and the forth column has the cell phone number. Some people have multiple parts for the first name, and that's why you see some of that weird splitting, ReDim-ing and joining back together. That part works just fine.
The problem arises when you have multiple people with the same last name. The function would find someone with the right last name, going through the first If statement. Then it would compare the first name. If it matches, it would return the value of the cell phone number like it should. After that, the for loop stops, even if the first name doesn't match up. So if someone happens to the same last name, but the first name doesn't check up, it returns nothing.
I've tried putting the return call outside of the loop all together, and it still doesn't make a difference.
Since you're not using a database, a primary key column might be difficult. With your current set up you could try this.
It
doesn't look through every single cell in the column
uses Option Explicit
will return the first find and exit
will be indifferent to upper/lower case and leading/trailing white space.
.
Option Explicit
Function findCell(namePerson As String) As String
Dim splitName As Variant
Dim lastName As String
Dim firstName As String
splitName = Split(namePerson, " ")
lastName = splitName(UBound(splitName))
ReDim Preserve splitName(UBound(splitName) - 1)
firstName = Join(splitName)
Dim ws As Worksheet, lastrow As Long, r As Long
Set ws = Worksheets("IT")
lastrow = ws.Cells(1, 1).End(xlDown).Row 'or whatever cell is good for you
For r = 1 To lastrow
If UCase(Trim(ws.Cells(r, 1))) = UCase(Trim(lastName)) _
And UCase(Trim(ws.Cells(r, 2))) = UCase(Trim(firstName)) Then
findCell = ws.Cells(r, 4)
Exit For
End If
Next r
End Function
It seems like you're postponing dealing with the real issue by trying to fix this one.
You're running into issues because your "keys" (name) aren't unique. You've worked around one naming clash, and now you're trying to work around another one.
What about getting a key (like a GUID) that you know will be unique? Then there won't be the need to work around this any more.