Convert contactitems from access to outlook

I've run into a problem
This export the items from access to outlook. My problem is I do not wat to export the items to the default folder of outlook but to a custom folder the I have made myself.
The foldername is Quick and it is in the root of my outlook today, type is contact items
How do I do this.
Thanx to ansvers

Private Sub Convert_outlook_Click()

' Maak DAO Objects.
   Dim oDataBase As DAO.Database
   Dim rst As DAO.Recordset
   Set oDataBase = CurrentDb
   Set rst = oDataBase.OpenRecordset("vrijwilligers")

' Maak Outlook Objects.
   Dim ol As New Outlook.Application
   Dim olns As Outlook.Namespace
   Dim cf As Outlook.MAPIFolder
   Dim c As Outlook.ContactItem
   Dim Prop As Outlook.UserProperty
   Dim lngPosition As Long
   Dim varReturn As Variant
   
   lngCount = rst.RecordCount
   strMessage = lngCount & " contact Adressen overzetten naar Outlook -- doen?"
   lngResult = MsgBox(strMessage, vbYesNo, "beginnen?")
      'Exit if user says No
   If lngResult = vbNo Then Exit Sub
   strMessage2 = lngCount & " Adressen te gaan"
   varReturn = Application.SysCmd(acSysCmdInitMeter, strMessage2, lngCount)
   Set olns = ol.GetNamespace("MAPI")
   Set cf = olns.GetDefaultFolder(olFolderContacts)
   'GetDefaultFolder(olFolderContacts)
   i = 1
   With rst
      .MoveFirst

' doorloop de accessdatabase.
      Do While Not .EOF
      For lngPosition = 1 To lngCount

' Maak een nieuw contactitem.
         Set c = ol.CreateItem(olContactItem)

         ' Specify which Outlook form to use.
         ' Change "IPM.Contact" to "IPM.Contact.<formname>" if you've
         ' created a custom Contact form in Outlook.
         c.MessageClass = "IPM.Contact"

         ' Create all built-in Outlook fields.
         If ![sx] <> "" Then c.Title = ![sx]
         If ![Voornaam] <> "" Then c.FirstName = ![Voornaam]
         If ![Achternaam] <> "" Then c.LastName = ![Achternaam]
         If ![straat] <> "" Then c.HomeAddressStreet = ![straat]
         If ![gemeente] <> "" Then c.HomeAddressCity = ![gemeente]
         If ![Pcode] <> "" Then c.HomeAddressPostalCode = ![Pcode]
         If ![Land] <> "" Then c.HomeAddressCountry = ![Land]
         If ![Telefoon] <> "" Then c.HomeTelephoneNumber = ![pf] & "/" & ![Telefoon]
         If ![fax] <> "" Then c.HomeFaxNumber = ![pf] & "/" & ![fax]
         If ![gsm] <> "" Then c.MobileTelephoneNumber = ![gsm]
         If ![E-mailadres] <> "" Then c.Email1Address = ![E-mailadres]
         '
         ' Save the contact.
         c.Save
      strMessage2 = lngCount - lngPosition & " Adressen te gaan"
      varReturn = Application.SysCmd(acSysCmdInitMeter, strMessage2, lngCount)
      varReturn = Application.SysCmd(acSysCmdUpdateMeter, lngPosition)
      .MoveNext
      Next lngPosition
      Loop
   End With
varReturn = Application.SysCmd(acSysCmdClearStatus)
   DoCmd.Hourglass False
End Sub
GoossensFAsked:
Who is Participating?
 
svenkarlsenCommented:
GoossensF,

Drop (or comment out) this line:
    > Set cf = olns.GetDefaultFolder(olFolderContacts)

Add this line instead/below:

    Set cf = olns.folders("Quick")

If you don't get the required result, try commenting out that line and put in this:

    set cf = olns.PickFolder

This should bring up an explorer window where you can see the available folders, - if Quick is not there, maybe it has another name in the namespace? Try guessing ?


Sven
0
 
svenkarlsenCommented:
Hi GoossensF,

You just avoid using .DefaultFolder().

NameSpace is a collection of all folders and property .Folders holds all. When you .use .DefaultFolder it's like asking VB to do a search within the namespace for the default folder for e.g. Contacts or Calendar.

You can check what the NameSpace 'is looking at' by:

myNameSpace.PickFolder method, - this will bring up a selection box for folder (sometimes a neat function ;-)

Use this to assign your custom folder:
   Set myFolder = myNameSpace.folders("Folder Name")

"Folder Name" can be a little tricky, if display name has been changed, it's still the original folder name that counts.


Kind regards,
Sven
0
 
GoossensFAuthor Commented:
So far I am with you but how do I adjust my code for this, I think I am in a deadlock :)
I have tried some things but it wont work
0
 
will_scarlet7Commented:
Interesting app for transferring back and for th from Outlook and Access:

http://www.downlinx.com/proghtml/199/19941.htm
0
 
will_scarlet7Commented:
If you have not yet put this one to rest you could also check out using Outloo Redemption to write straight to your Contacts folder via code from Access.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.