Outlook and Excel Integration for Contacts

[Shauna Koppang]

Hi,

I found this code from one of your responses, but as a
rank beginner - first attempt at this kind of thing, that
I don't know enought as to where to go from here.

I have a UserForm with 1 ComboBox (ComboBox1) and 1
Command Button (CommandButton1). I need to somehow, and
maybe this is not the best way to do it, get the user when
they click the combo box to have it display their Contacts
folder (will eventually be a Public Folder) to see the
names of the companies. They would pick a name and it
would insert the address, phone contact name et al fields
into the worksheet at specific cells. I know this code it
not the right code but it appears to set a link up in some
way.

So any help where to begin would be truly appreciated!!!!!

Private Sub UserForm_Initialize()

'Sets ComboBox RowSource to Outlook Contacts Company Field
'ComboBox ControlSource is D3
'ComboBox1.RowSource = "Names"

End Sub

Private Sub CommandButton1_Click()
Sub GetContact()

Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder
Dim olCi As ContactItem

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.Folders("Personal Folders").Folders
("Contacts")

For Each olCi In Fldr.Items
If olCi.NickName = "DoubleD" Then
Debug.Print olCi.FullName,
olCi.Email1Address
End If
Next olCi

Set olCi = Nothing
Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub

'Next coding needs to be insert into cells D3 =
Company, D4 = Street Address, D5 = Locality, D6 =
State_or_Province D7 = Postal_Code, D8 = Display_Name, D9
= Office_Telephone_Number, D10 = Business_Fax_Number & B3
Department_Name

'Hides UserForm1
UserForm1.Hide
End Sub

Thanks again SO MUCH!!! If I can just get this I can
finish my project!

Shauna

 

[steve]

Shauna,

Don't know for sure, but check out this macro to open a file for ideas.
Check the VB help for more details.

The GetOpenFilename part just opens the dialog to open a file.
You might add a ChDir to select the folder.

steve

Sub OpenMyFile()
Dim GetFiles As Variant
Dim iFiles As Long
Dim nFiles As Long
GetFiles = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt),*.txt", _
Title:="Select Files To Open", MultiSelect:=True)
If TypeName(GetFiles) = "Boolean" Then
''' GetFiles is False if GetOpenFileName is Canceled
MsgBox "No Files Selected", vbOKOnly, "Nothing Selected"
End
Else
''' GetFiles is Array of Strings (File Names)
''' File names include Path
nFiles = UBound(GetFiles)
For iFiles = 1 To nFiles
'' List Files in Immediate Window
Debug.Print GetFiles(iFiles)
Next
End If
End Sub

 

[Shauna Koppang]

HI Steve,

Thanks for that but I think the coding I got below is
probably a better start as it sets up the access to
Outlook.

Being so new to this what you sent might help for another
project, but not this one as I have to access Outlook and
access a specific folder and fields within it and have
them populate and area of a speadsheet.

But thanks for your assistance. I truly appreciate all
those people who have been helping me through this project
and tremendous learning process.

Shauna

 

[steve]

Shauna,

Yep! I don't do that much interfacing with Outlook, so that is another weak
spot in my resume...

But glad the code I sent may be of help later.

 

[Dick Kusleika]

Shauna

Change this part

For Each olCi In Fldr.Items
If olCi.NickName = "DoubleD" Then
Debug.Print olCi.FullName,
olCi.Email1Address
End If
Next olCi

to

Me.ComboBox1.Clear

For Each olCi In Fldr.Items
Me.ComboBox1.AddItem olCi.FullName
Next olCi

That will populate the combobox with all of the contacts in the folder.
Then move this macro to the Initialize event so that the combobox is
re-populated each time you run the form.

I assume the button should put the relevant data on the worksheet, so make
your button's click event look something like this

For Each olCi In olFldr.Items
If olCi.FullName = Me.ComboBox1.Value Then
Sheet1.Range("d3").Value = olCi.CompanyName
Sheet1.Range("d4").Value = olCi.BusinessAddress
'Other data you want to write goes here in the same format
End If
Next olCi

This loops through the contacts and find the one that matches the one
selected in the combobox. Then it writes the pertinent information to
whatever cells you choose.

Here's another thing you want to do: Make module level variables for olApp,
olNs and olFldr - that is, Dim those variables above all your procedures,
but below the Option Explicit statement. The Code Module behind your
userform should look roughly like this

Option Explicit

Dim olApp as Outlook.Application
Dim olNs as Outlook.NamesSpace
Dim olFldr as Outlook.MAPIFolder

Private Sub CommandButton1_Click()
'code to write to cells

Unload Me 'Don't just hide, actually unload it
End Sub

Private Sub Userform_Initialize()
Set olApp = New Outlook.Application
Set olNs = olApp.GetNameSpace("MAPI")
Set olFldr = olNs.GetDefaultFolder("Contacts")

'populate combobox here
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub

This way, you'll only have to connect to Outlook when the userform is loaded
and disconnect when it is unloaded as opposed to connecting to it everytime
you do something with outlook. The variables (module level variables) at
the top can be used in any sub in that module, so you don't have to Dim them
in every module.

That's a lot of info, I know. Do what you can with it and post back when
you get stuck. For a faster reply, make sure you reply to this post - it
will show up as red in my newsreader and I'll see it for sure that way.

 

[Shauna Koppang]

Hi Dick,

Thanks again so much!!!

OK so here is how I change my code. Does not seem to work
yet. Probably because I am still so novice I put things
in the wrong places.

Private Sub UserForm_Initialize()

'Sets ComboBox Outlook Contacts FullName

Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder
Dim olCi As ContactItem

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder("Contacts")


Me.ComboBox1.Clear

For Each olCi In Fldr.Items
Me.ComboBox1.AddItem olCi.FullName 'Full Name -
Change to Company Name?
Next olCi

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer,
CloseMode As Integer)

Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub

Private Sub CommandButton1_Click()
Option Explicit

Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder
Dim olCi As ContactItem

For Each olCi In olFldr.Items
If olCi.FullName = Me.ComboBox1.Value Then
Sheet1.Range("d3").Value = olCi.CompanyName
Sheet1.Range("d4").Value = olCi.BusinessAddress
'Other data you want to write goes here in the
same format
End If
Next olCi


'Hides UserForm1
'UserForm1.Hide
Unload Me

End Sub

Can you please let me know what I need to change!

Thanks again so much. I feel like I am SO CLOSE to
getting this

Shauna

 

[Dick Kusleika]

Shauna

What about it doesn't work? Read on.

Private Sub UserForm_Initialize()

'Sets ComboBox Outlook Contacts FullName

Put these three Dim lines above any code you have in that module - above the
first line that says Sub. By Dimming these inside the Initialize procedure,
they will only be available to this sub - so define them outside of all subs
and they will be available to all the subs.

Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder

The rest of this looks OK, but you're probably getting a compile error
because of the above.

Dim olCi As ContactItem

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder("Contacts")


Me.ComboBox1.Clear

For Each olCi In Fldr.Items
Me.ComboBox1.AddItem olCi.FullName 'Full Name -
Change to Company Name?
Next olCi

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer,
CloseMode As Integer)

The variables are not defined in the scope of this procedure. Putting the
three Dim statements outside of any Subs will solve that. I assume this is
where you're getting the error.

Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub

Private Sub CommandButton1_Click()
Option Explicit

Get rid of these three Dim statements. You'll be using the variables that
you define outside of any Subs for every sub that references them.

Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder

This looks fine. Make sure your ComboBox is called ComboBox1 and the sheet
to which you are trying to write is called Sheet1. You can also use
something like ThisWorkbook.Sheets("MySheetName").Range...

Dim olCi As ContactItem

For Each olCi In olFldr.Items
If olCi.FullName = Me.ComboBox1.Value Then
Sheet1.Range("d3").Value = olCi.CompanyName
Sheet1.Range("d4").Value = olCi.BusinessAddress
'Other data you want to write goes here in the
same format
End If
Next olCi


'Hides UserForm1
'UserForm1.Hide
Unload Me

End Sub

Can you please let me know what I need to change!

Thanks again so much. I feel like I am SO CLOSE to
getting this

Shauna

Keep posting, we'll figure it out.

 

[Shauna Koppang]

Hi Dick,

Still no luck. I know this is a lot to ask but I have to
have this part understood and completed today as I start
the actual project either Monday or Tuesday. Could I send
you the file to look at?

Shauna

 

[Shauna Koppang]

HI Dick,

I was able to get my resource here to look at it for a few
minutes and we got it working!! Thanks again for your
help!! However, I have it pointing to a folder in Default
(called Merges) to test, but the project is going to
require the code to point to a Public folder. I have not
been able to find any code on this. Could you look at
this and let me know what changes I have to make to get it
to point to a Public folder?

Option Explicit

Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim olFldr As MAPIFolder
Dim mynewfolder As MAPIFolder



Private Sub UserForm_Initialize()

'Sets ComboBox Outlook Contacts FullName
Dim olCi As ContactItem

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderContacts)
'Sets which folder to pick from in a Personal Folder
Set mynewfolder = olFldr.Folders("Merge")


Me.ComboBox1.Clear

'For Each olCi In olFldr.Items
For Each olCi In mynewfolder.Items
Me.ComboBox1.AddItem olCi.CompanyName 'Full Name -
Change to Company Name?
Next olCi

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer,
CloseMode As Integer)

Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
Set mynewfolder = Nothing

End Sub


Private Sub CommandButton1_Click()

Dim olCi As ContactItem

For Each olCi In mynewfolder.Items
'For Each olCi In olFldr.Items
If olCi.CompanyName = Me.ComboBox1.Value Then
Sheet1.Range("d3").Value = olCi.CompanyName
Sheet1.Range("d4").Value = olCi.BusinessAddress
Sheet1.Range("B3").Value = olCi.Department
'Other data you want to write goes here in the
same Format
End If
Next olCi

'Hides UserForm1
'UserForm1.Hide
Unload Me

End Sub

Shauna

 

[Shauna Koppang]

Hi Dick,

Another question. When it inserts the Business Address it
puts in a square in the cell between the address and the
city. What coding would I use to remove it, as not sure
which character it is?
So the coding would be something like find any of these
characters and remove them. I think I may also have to
add in coding to select the row the Address goes in and
the AutoFit it.

Thanks again for all your help! You have been a
invaluable and I so appreciate all your efforts in helping
me!!

Am just about ready to tackle the project next week. -
Just need these and the coding to contact folder in Public
Folder and or Favorites in Public Folders!

Shauna

 

[Shauna Koppang]

Got it for Public Folders! Posted this in case anyone
else is following this thread.

Option Explicit

Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim olFldr As MAPIFolder
'Dim mynewfolder As MAPIFolder



Private Sub UserForm_Initialize()

'Sets ComboBox Outlook Contacts FullName
Dim olCi As ContactItem

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
'Sets to Personal Default folders
'Set olFldr = olNs.GetDefaultFolder(olFolderContacts
'Sets for Public Folders
Set olFldr = olNs.Folders("Public Folders").Folders _
("All Public Folders").Folders("Shared Public
Folders").Folders _
("SCI Client Profile for Technicians")

'Set mynewfolder = olFldr.Folders("Old Contacts")


Me.ComboBox1.Clear

For Each olCi In olFldr.Items
'For Each olCi In mynewfolder.Items
Me.ComboBox1.AddItem olCi.CompanyName 'Full Name -
Change to Company Name?
Next olCi

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer,
CloseMode As Integer)

Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
'Set mynewfolder = Nothing

End Sub


Private Sub CommandButton1_Click()

Dim olCi As ContactItem

'For Each olCi In mynewfolder.Items
For Each olCi In olFldr.Items
If olCi.CompanyName = Me.ComboBox1.Value Then
Sheet1.Range("d3").Value = olCi.CompanyName
Sheet1.Range("d4").Value = olCi.BusinessAddress
'Other data you want to write goes here in the
same Format
End If
Next olCi

'Go to Cell A4 and AutoFit Row
Application.Goto Reference:="R4C1"
Selection.Rows.AutoFit

'Hides UserForm1
'UserForm1.Hide
Unload Me

End Sub

Still need how to find and remove the square though and I
am done!!! Yeha

Shauna

 

[Dick Kusleika]

Shauna

I don't know how to find Public Folders, but here's what I would do. Create
a new module and paste this into it

Option Explicit

Dim ol As Outlook.Application
Dim ns As Outlook.NameSpace
Dim LevelCount As Long

Sub FindFolders()

Dim Fldr As Outlook.MAPIFolder

Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
LevelCount = 0

For Each Fldr In ns.Folders
Debug.Print Fldr.Name
FindSubFldrs Fldr
Next Fldr


End Sub


Sub FindSubFldrs(Fldr As MAPIFolder)

Dim SubFldr As MAPIFolder
LevelCount = LevelCount + 1

For Each SubFldr In Fldr.Folders
Debug.Print Application.Rept(vbTab, LevelCount) & SubFldr.Name
If SubFldr.Folders.Count > 0 Then
FindSubFldrs SubFldr
End If
Next SubFldr

LevelCount = LevelCount - 1

End Sub

Delete everything in the Immediate Window and run FindFolders. This will
give you a hierarchical display of all the folders in the namespace. See if
you can find the right folder in there and it will tell you what the path
is.

As for the business address, those are Chr(10) and Chr(13) (even though you
only see one, you want to get rid of both), line feed and carriage return
respectively. If you are using XL2000 or newer, you can strip them out with
the replace function.

Range("D4").Value =
Replace(Replace(olCi.BusinessAddress,Chr(10),""),Chr(13),"")

 

[Dick Kusleika]

For Each olCi In mynewfolder.Items
'For Each olCi In olFldr.Items
If olCi.CompanyName = Me.ComboBox1.Value Then
Sheet1.Range("D3").Value = olCi.CompanyName

***Replace this line with the new line

 

[steve]

Shauna,

If it pastes in red, Excel doesn't like all the spaces, indentations, line
wrap, etc.

Put Option Explicit at the top of the module (above) the code and do a
compile. Problem areas should be highligted. Blank areas should be deleted
(Excel thinks that code or something should be there).

Often when code is included in a post it wraps and all the code from a
single line gets split onto 2 lines. You either have to get it back onto a
single line or use the underscore to indicate that it continues on the next
line.

At least this is what happens to me when I "steal" code from the forum.
(This happens frequently when people type their code directly into the post)

 

[Tom Ogilvy]

just a thought, but it wouldn't work in Excel 97.

Regards,
Tom Ogilvy