UserForm Code For Contact Links

Status
Not open for further replies.

LMS

Senior Member
Outlook version
Outlook 2007
Email Account
Exchange Server
To the SMART WOMAN!!!!;););)I have the following code in a UserForm which has two comboxes, and the first comboxbox is my list of categories...and the second combobox shows the contact names of the contacts that are a part of the category I click on in the first combobox....but the name of the contact is not a link to the contact....so is there a quick fix to this so that the line which is:
Me.ddlContacts.addItem ctc.FullName is changed so it is not just the FullName of the contact, but the link to the contact....

so here is the code and I appreciate a quick response and it solves everything for me.....thanks much:

Private Sub ddlCategories_Change()
Dim objOutlook As outlook.Application
Dim objNS As outlook.NameSpace
Dim objFolder As outlook.MAPIFolder
Dim objFolder2 As outlook.MAPIFolder
Dim objFolder3 As outlook.MAPIFolder
Dim objFolder4 As outlook.MAPIFolder
Dim objFolder5 As outlook.MAPIFolder
Dim objFolder6 As outlook.MAPIFolder
Dim objFolder7 As outlook.MAPIFolder
Dim objFolder8 As outlook.MAPIFolder
Dim ctc As ContactItem
Dim Category As String

Set objOutlook = CreateObject("Outlook.Application")
Set objFolder = objOutlook.Session.GetDefaultFolder(OlDefaultFolders.olFolderContacts)
Set objFolder2 = objOutlook.Session.GetDefaultFolder(OlDefaultFolders.olFolderContacts).Folders("Test")
Set objFolder3 = objOutlook.Session.GetDefaultFolder(OlDefaultFolders.olFolderContacts).Folders("Family")
Set objFolder4 = objOutlook.Session.GetDefaultFolder(OlDefaultFolders.olFolderContacts).Folders("Friends")
Set objFolder5 = objOutlook.Session.GetDefaultFolder(OlDefaultFolders.olFolderContacts).Folders("Test2")
Set objFolder6 = objOutlook.Session.GetDefaultFolder(OlDefaultFolders.olFolderContacts).Folders("Test3")
Set objFolder7 = objOutlook.Session.GetDefaultFolder(OlDefaultFolders.olFolderContacts).Folders("Test").Folders("SubTest")
Set objFolder8 = objOutlook.Session.GetDefaultFolder(OlDefaultFolders.olFolderContacts).Folders("Test").Folders("SubTest2")

Category = Me.ddlCategories.Text

Me.ddlContacts.Clear

For Each ctc In objFolder.items
If ctc.Categories = Category Then
Me.ddlContacts.addItem ctc.FullName
End If
Next

For Each subFolder In objOutlook.Session.GetDefaultFolder(OlDefaultFolders.olFolderContacts).Folders
addItem subFolder, Category
Next

For Each subFolder In objOutlook.Session.GetDefaultFolder(OlDefaultFolders.olFolderContacts).Folders("Test").Folders
addItem subFolder, Category
Next


End Sub
Private Sub addItem(subFolder, categoriesName As String)
For Each ctc In subFolder.items
If ctc.Categories = categoriesName Then
Me.ddlContacts.addItem ctc.FullName
End If
Next
End Sub

Private Sub UserForm_Initialize()
Dim Category

For Each Category In Application.Session.Categories
Me.ddlCategories.addItem Category
Next
End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
You need to use a filter and search for the contact. If your goal to open the contact?

This should work - you'll need to pass the name in the userform to the macro as strFullname and may need to pass the folder to myContacts.

Public Sub FindContactChange()
Dim Selection As Selection
Dim currentItem As Object
Dim strFullname As String
Dim myContacts As Items
Dim myItem As ContactItem

' may need to get myContact from the userform
Set myContacts = Session.GetDefaultFolder(olFolderContacts).Items
On Error Resume Next

' get strFullname from the userform
Set myItem = myContacts.Find("[FullName]=" & Chr(34) & strFullname & Chr(34))
If TypeName(myItem) = "ContactItem" Then
If Not TypeName(myItem) = "Nothing" Then
' Match found
myItem.Display
End If
End If

Err.Clear
Set myItem = Nothing
Set myContacts = Nothing
Set objMail = Nothing
Set currentItem = Nothing
Set Selection = Nothing

End Sub
 

LMS

Senior Member
Outlook version
Outlook 2007
Email Account
Exchange Server
thank you so much....can you please tell me where to put the macro you just wrote down? That is what I don't understand where to put it.....thank you as i would love to try it!!
 

LMS

Senior Member
Outlook version
Outlook 2007
Email Account
Exchange Server
thank you so much....can you please tell me where to put the macro you just wrote down? That is what I don't understand where to put it.....thank you as i would love to try it!!

And if this is added to the Userform code, is there anything to delete from my first code?
 

LMS

Senior Member
Outlook version
Outlook 2007
Email Account
Exchange Server
Any update tonight please?! I just need to know where do I put what you wrote in And if this is added to the Userform code, is there anything to delete from my first code?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
It would go in the module. You need to pass the values from the user form selection to it.
 

LMS

Senior Member
Outlook version
Outlook 2007
Email Account
Exchange Server
thanks very much....I put it in a new module 38 and the Userform is Userform22.....so what do I add to both so when I run the the Module it does what needs to do thru the Userform 22......I used the code you gave me, but don't now how to connect the Module to the Userform......quick answer maybe???
 

LMS

Senior Member
Outlook version
Outlook 2007
Email Account
Exchange Server
To the Smart Woman!!! Here is the updated code for Userform22 that does not need a macro to run it and past in from it.....this code runs two comboxboxes....one is the list of categories and after clicking on a category, it opens up on the the other combobox the list contacts for that category from all subfolders and sub-subfolders......but for reason does not show the contacts in the Contact folder re the categories...but other than that is shows all are llnks to the contact themselves....so what to fix so shows the contacts from the Contact folder....here it is in the next post:
 

LMS

Senior Member
Outlook version
Outlook 2007
Email Account
Exchange Server
Private Sub ddlCategories_Change()
Dim objOutlook As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim ctc As ContactItem
Dim FolderName As String
Dim fldr As Folder
Dim flder As Outlook.Folder
Dim myContacts As Outlook.items
Dim Category As String
Category = Me.ddlCategories.Text

Set objOutlook = CreateObject("Outlook.Application")
Set objFolder = objOutlook.Session.GetDefaultFolder(OlDefaultFolders.olFolderContacts)

Me.ddlContacts.Clear

If objFolder.Folders.Count > 0 Then
For Each fldr In objFolder.Folders
Set myContacts = fldr.items.Restrict("[Categories] = '" & Category & "'")
If myContacts.Count > 0 Then
myContacts.Sort "[Fullname]", False

For Each ctc In myContacts
Me.ddlContacts.addItem ctc.FullName
Next
End If

For Each flder In fldr.Folders
Set myContacts = flder.items.Restrict("[Categories] = '" & Category & "'")
If myContacts.Count > 0 Then
myContacts.Sort "[Fullname]", False

For Each ctc In myContacts
Me.ddlContacts.addItem ctc.FullName
Next
End If

Next
Next
End If

End Sub

Private Sub UserForm_Initialize()
'The loads the Outlook userform and populates the combobox of contact folders.

Dim objOutlook As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim Category
Set objOutlook = CreateObject("Outlook.Application")

For Each Category In Application.Session.Categories
Me.ddlCategories.addItem Category
Next




End Sub

Private Sub ddlContacts_Change()
'This opens the contact form for the contact selected.
Dim objOutlook As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim ctcItems As Outlook.items
Dim ctc As ContactItem
Dim objFolder As Outlook.MAPIFolder
Dim ctcFolder As Outlook.MAPIFolder
Dim FolderName As String
Dim ContactName As String
Dim FoundFolder As Outlook.Folder

Set objOutlook = CreateObject("Outlook.Application")
Set objFolder = objOutlook.Session.GetDefaultFolder(OlDefaultFolders.olFolderContacts)

ContactName = Me.ddlContacts.Text

If objFolder.Folders.Count > 0 Then
For Each fldr In objFolder.Folders
Set ctcItems = fldr.items.Restrict("[FullName] = '" & ContactName & "'")
If ctcItems.Count > 0 Then
Me.Hide
For Each ctc In ctcItems
ctc.Display
Next
Exit Sub
Else
For Each flder In fldr.Folders
Set ctcItems = flder.items.Restrict("[FullName] = '" & ContactName & "'")
If ctcItems.Count > 0 Then
Me.Hide
For Each ctc In ctcItems
ctc.Display
Next
Exit Sub
End If
Next
End If
Next
End If

End Sub

Private Function FullFolderName(ByVal FolderName As String) As Outlook.Folder


End Function
 

LMS

Senior Member
Outlook version
Outlook 2007
Email Account
Exchange Server
Just in case, you see my questions above just in case you know what to upgrade....and also, if you see the code area that sorts the contacts by their name...which is line: myContacts.Sort "[Fullname]", False what can I add and where to add it to sort the names of the Categories on an alphebetical basis....?

Very happy to hear back soon....as the category area is even faster for organizing things...
 

LMS

Senior Member
Outlook version
Outlook 2007
Email Account
Exchange Server
Got it! Any other updates re the other areas .so what to fix so shows the contacts from the Contact folder....and not just the subfolders?
 

LMS

Senior Member
Outlook version
Outlook 2007
Email Account
Exchange Server
Got it! Any other updates re the other areas .so what to fix so shows the contacts from the Contact folder....and not just the subfolders?
 

LMS

Senior Member
Outlook version
Outlook 2007
Email Account
Exchange Server
Still waiting for the Smart Woman!!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
For Each fldr In objFolder.Folders - the default folder is not an object in itself. Use the entire mailbox instead. As long as you are restricting it to contact items, that is all it will return.
 

LMS

Senior Member
Outlook version
Outlook 2007
Email Account
Exchange Server
Thank you as usual!!

Please write down the specific code and tell me what to replace to.
 

LMS

Senior Member
Outlook version
Outlook 2007
Email Account
Exchange Server
Still waiting for the Smart Woman to give me the code, wherr to put it, and what delete!'
 
Status
Not open for further replies.
Top