[Resolved] Export addresses from Excel to Outlook

[c03cg]

Im writing a small function in VBA in Excell to create an Address book in Outlook 2003 from the list of staff names & addresses in an Excell spreadsheet.

It needs to be done this way as the software in use to store the staff details can only output to a .csv file.

Im thinking i have to do somthing along the lines of:

Dim oApp As Outlook.Application
Dim oAddress As Outlook.AddressList 'Is this correct?
 
Set oApp = New Outlook.Application
Set oAddress = 'Not entirely sure of how to assign this

And then read through each line of the spreadsheet creating entries?

[c03cg]

ok, so sofar i can add a new contact with the needed details using:

Dim oApp As Outlook.Application
    Dim oNS As Outlook.Namespace
    Dim iOne As Integer
    
    Set oApp = New Outlook.Application
    Set oNS = oApp.GetNamespace("MAPI")
    
    Dim oContact As Outlook.ContactItem
    
    'Set oContact = oNS.GetItemFromID(Range("B2") & " " & Range("A2"))
    iOne = 1
    
    Do While iOne < 200
        Range("E" & iOne + 1).Select
        ActiveCell.FormulaR1C1 = "=R[-1]C+1"
        iOne = iOne + 1
    Loop
    
    Columns("E:E").Select
    Selection.NumberFormat = "000"
    
    Application.Cursor = xlWait
    Set oContact = oApp.CreateItem(olContactItem)
    oContact.CompanyName = "President Kennedy School"
    oContact.Email1Address = Range("D2").Text
    oContact.Email1AddressType = "Business"
    oContact.Email1DisplayName = Range("B2").Text & " " & Range("A2").Text
    oContact.FileAs = Range("A2").Text & ", " & Range("B2").Text
    oContact.FirstName = Range("B2").Text
    oContact.FullName = Range("B2").Text & " " & Range("A2").Text
    oContact.LastName = Range("A2").Text
    oContact.UserProperties("PKSID") = oContact.User1
    oContact.User1 = "PKS" & Range("E2")
    oContact.Save
    Application.Cursor = xlDefault

I beleive ive set up 'User1' to add a field called PKSID and fill it with a 3 digit number..... how can i search the contacts by this so i dont duplicate?

[RobDog888]

Use the Restrict or Find methods. One of them is for use with custom properties. Cant remember right now.

Also, if you save the .EntryID property of the contact item that would be your unique ID throughout your Outlook store.

[c03cg]

Cheers for the advice Rob..... searching them atm..... but what outlook property do i have to search within?

[RobDog888]

The .Items collection of the MAPIFolder your creating or storing the contact items in.

If you use the .EntryID property you can also use the .GetItemFromID method of the NameSpace object class.[/color]

[c03cg]

Cool.... its working, cheers RobDog, my code now looks like this:

Sub Create_Address_Book()
 
    Dim oApp As Outlook.Application
    Dim oNS As Outlook.Namespace
    Dim oCF As Outlook.MAPIFolder
    Dim iOne As Integer
    
    Set oApp = New Outlook.Application
    Set oNS = oApp.GetNamespace("MAPI")
    
    Dim oContact As Outlook.ContactItem
    
    Set oCF = oNS.Folders(1).Folders("Contacts")
    
    iOne = 2
    
    Application.Cursor = xlWait
    
    Do While Not Range("A" & iOne) = ""
        Set oContact = oCF.Items.Find("[FullName] = " & Range("b" & iOne) & " " & Range("a" & iOne) & "")
        
        If TypeName(oContact) = "Nothing" Then
            Set oContact = oApp.CreateItem(olContactItem)
            oContact.CompanyName = "President Kennedy School"
            oContact.Email1Address = Range("D" & iOne).Text
            oContact.Email1AddressType = "Business"
            oContact.Email1DisplayName = Range("B" & iOne).Text & " " & Range("A" & iOne).Text
            oContact.FileAs = Range("A" & iOne).Text & ", " & Range("B" & iOne).Text
            oContact.FirstName = Range("B" & iOne).Text
            oContact.FullName = Range("B" & iOne).Text & " " & Range("A" & iOne).Text
            oContact.LastName = Range("A" & iOne).Text
            oContact.Save
        Else
            Application.Cursor = xlDefault
            MsgBox "The contact '" & oContact & "' already exists"
            Application.Cursor = xlWait
        End If
           
        iOne = iOne + 1
    Loop
    
    Application.Cursor = xlDefault
    
End Sub

How do i change the Contacts view programaitically?

[RobDog888]

Set oApp.ActiveExplorer.CurrentFolder = oCF

[c03cg]

Cheers... but, being the doofus i am, didn't explain what i meant!

How do i set the Contacts folder to 'View by Company' programatically?

[RobDog888]

Oh, . You need to modify the View manually. Then use the View object and Views collection for that folder to save it out to an xml or text file. Then when you run your app you can read in the file and set the view of your folder to that read-in saved xml view.

You can just change the xml element using the xml parse class but its more code then its worth when you can do it this was with just a few lines of code and no references.

[c03cg]

Spot on.... cheers Rob, im going to mark the matter resolved, however if i get stuck with it, ill post again and PM you

Many thanks

[RobDog888]

My inbox is almost full so as long as you post back to this thread I will get it since I subscribe to all threads I post to.

[c03cg]

RD.......

ive got this:

Sub viewCheck()
    
    Dim oApp As Outlook.Application
    Dim oNS As Outlook.NameSpace
    Dim oCF As Outlook.MAPIFolder
    Dim oView As Outlook.View
    Dim oviews As Outlook.Views
    
    Set oApp = New Outlook.Application
    Set oNS = oApp.GetNamespace("MAPI")
    Set oCF = oNS.Folders(1).Folders("Contacts")
    Set oView = oCF.CurrentView
    Set oviews = oCF.Views
    
    MsgBox oView.XML
    
End Sub

which obvioulsy displays the XML in a msgbox, how do i get Excell to set outlook to this view? The view name is 'By Company' and its a standard outlook one

Any ideas?

[RobDog888]

You mean to just change the view or customize it?

[c03cg]

Just change it from the default view to the 'By Company' view

[RobDog888]

Oh, ok. Thats easier. I think this is it.

'...
    '...
    Set oViews = oTaskBox.Views
    Set oView = oViews.Item("By Company")
    'Set the view to the current view
    oView.Save
    oView.Apply

[c03cg]

Good lad! Worked like a charm........ set oCF (current folder) to the contacts folder, then did:

Set oViews = oCF.Views
    Set oView = oViews.Item("By Company")
    oView.Save
    oView.Apply

Many thanks again!

[RobDog888]

No prob.

I guess I still got it as I did it from memory and typed it into the reply box without testing (whew, glad it worked on first try lol).