Erwin Craps - IT Helps
Erwin.Craps at ithelps.be
Thu Jan 22 15:18:42 CST 2004
Hi Susan
Here's some code that creates contacts in Outlook from Access.
The function needs adapting, cause I grabbed it right of my app...
Public Function CreateContactsInOutlook()
' Comments :
' Parameters: -
' Modified :
'
' --------------------------------------------------
'TVCodeTools ErrorEnablerStart
On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Dim oOut As Outlook.Application
Dim oNSpace As Outlook.NameSpace
Dim oFolderContact As Outlook.MAPIFolder
Dim oFolder As Outlook.MAPIFolder
Dim objOItem As Object
Dim strFolderName As String
Dim rsCust As Recordset
Dim strSQL As String
Dim intCounter As Integer
Dim lngItemCounter As Long
Dim varCUST_GID As Variant
DoCmd.Hourglass True
Set oOut = Outlook.Application
Set oNSpace = oOut.GetNamespace("MAPI")
Set oFolderContact = oNSpace.GetDefaultFolder(olFolderContacts)
'Create Folders
strFolderName = "IT Helps Relations"
On Error Resume Next
Set oFolder = oFolderContact.Folders(strFolderName)
If Err <> 0 Then
On Error GoTo PROC_ERR
Set oFolder = oFolderContact.Folders.Add(strFolderName,
olFolderContacts)
Else
For lngItemCounter =
oFolderContact.Folders(strFolderName).Items.Count To 1 Step -1
oFolderContact.Folders(strFolderName).Items(lngItemCounter).Delete
DoEvents
Next lngItemCounter
End If
On Error Resume Next
oFolder.ShowAsOutlookAB = True
On Error GoTo PROC_ERR
strSQL = "SELECT CUST_Main.*, CUST_Names.CUST_LID,
CUST_Names.Mailing ,CUST_Names.Language_LID, SUB_L_Titles.Title,
SUB_L_Titles.LetterStart, CUST_Names.FirstName, CUST_Names.SurName,
CUST_Names.DirectFax, CUST_Names.DirectPhone, CUST_Names.Email,
CUST_Names.GSMnumber, SUB_L_Countries.Country " _
& "FROM SUB_L_Countries RIGHT JOIN (CUST_Main LEFT JOIN
(SUB_L_Titles RIGHT JOIN CUST_Names ON SUB_L_Titles.Title_LID =
CUST_Names.Title_LID) ON CUST_Main.CUST_GID = CUST_Names.CUST_GID) ON
SUB_L_Countries.Country_LID = CUST_Main.Country_LID " _
& "WHERE CUST_Names.Mailing = true " _
& " ORDER BY CUST_Main.CUST_GID;"
Set rsCust = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
With rsCust
Do While rsCust.EOF = False
'Save Main company data
If varCUST_GID <> .Fields("CUST_GID") Then
If (Nz(.Fields("MainPhone")) <> "") Or
(Nz(.Fields("EmailAddress")) <> "") Then
Set objOItem =
oFolderContact.Folders(strFolderName).Items.Add(olContactItem)
objOItem.BusinessAddressCity = Nz(.Fields("City"))
objOItem.BusinessAddressCountry =
Nz(.Fields("Country"))
objOItem.BusinessAddressPostalCode =
Nz(.Fields("Postalcode"))
objOItem.BusinessAddressStreet =
Nz(.Fields("Street"))
objOItem.BusinessFaxNumber =
InternationalPhone(Nz(.Fields("MainFax")))
objOItem.BusinessTelephoneNumber =
InternationalPhone(Nz(.Fields("MainPhone")))
objOItem.CompanyName = Nz(.Fields("Company"))
objOItem.CustomerID = Nz(.Fields("CUST_GID"))
objOItem.Email1AddressType = "SMTP"
objOItem.Email1Address = Nz(.Fields("EmailAddress"))
objOItem.Fullname = Nz(.Fields("Company"))
objOItem.FileAs = objOItem.Fullname
objOItem.Save
End If
End If
'Save Contact person data
If (Nz(.Fields("DirectPhone")) <> "") Or
(Nz(.Fields("GSMnumber")) <> "") Or (Nz(.Fields("Email")) <> "") Then
Set objOItem =
oFolderContact.Folders(strFolderName).Items.Add(olContactItem)
objOItem.BusinessAddressCity = Nz(.Fields("City"))
objOItem.BusinessAddressCountry = Nz(.Fields("Country"))
objOItem.BusinessAddressPostalCode =
Nz(.Fields("Postalcode"))
objOItem.BusinessAddressStreet = Nz(.Fields("Street"))
objOItem.BusinessFaxNumber =
InternationalPhone(Nz(.Fields("DirectFax")))
objOItem.BusinessTelephoneNumber =
InternationalPhone(Nz(.Fields("DirectPhone")))
objOItem.MobileTelephoneNumber =
InternationalPhone(Nz(.Fields("GSMnumber")))
objOItem.CompanyName = Nz(.Fields("Company"))
objOItem.CustomerID = Nz(.Fields("CUST_LID"))
objOItem.Email1AddressType = "SMTP"
objOItem.Email1Address = Nz(.Fields("Email"))
objOItem.FirstName = Nz(.Fields("Firstname"))
objOItem.LastName = Nz(.Fields("Surname"))
objOItem.Title = Nz(.Fields("Title"))
objOItem.Fullname = Nz(.Fields("Surname")) & ", " &
Nz(.Fields("Firstname"))
objOItem.FileAs = objOItem.Fullname
objOItem.Save
End If
varCUST_GID = .Fields("CUST_GID")
.MoveNext
Loop
End With
'TVCodeTools ErrorHandlerStart
PROC_EXIT:
On Error Resume Next
rsCust.Close
Set rsCust = Nothing
Set oFolder = Nothing
Set oFolderContact = Nothing
Set oNSpace = Nothing
Set oOut = Nothing
DoCmd.Hourglass False
MsgBox "Finished!"
Exit Function
PROC_ERR:
Select Case Err
Case 0
'Do Nothing
Case Else
MsgBox Err.Description & vbCrLf & "CreateContactsInOutlook",
vbOKOnly, "ERROR:" & Err.Number
Resume PROC_EXIT
End Select
'TVCodeTools ErrorHandlerEnd
End Function
-----Oorspronkelijk bericht-----
Van: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] Namens MartyConnelly
Verzonden: donderdag 22 januari 2004 21:04
Aan: Access Developers discussion and problem solving
Onderwerp: Re: [AccessD] modifying Outlook contact items from Access
There is an Exchange OLEDB Provider available for those that use it.
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wss/wss
/_exch2k_search_tasks.asp
And this method might work
This article describes how you can open a connection to a Microsoft
Exchange or to a Microsoft Outlook mailbox by using ActiveX Data Objects
(ADO) and the Jet OLE DB provider
http://support.microsoft.com/?kbid=275262
Susan Harkins wrote:
>This is for instructional purposes, so I have to do it the long hard
>way. :)
>
>I can import the data into Access, modify it, and send it back to
>Outlook. I'm just wondering if there isn't a more direct route -- it
>would be cool if I could connect an Access form's to a recordset that's
>connected directly to Outlook -- so the changes in Access would be
>immediate -- I just don't know if that's possible, or even the best way
>to go about it.
>
>Susan H.
>
>
>
>
>>Hi Susan
>>Well I cheat. I have a number of Outlook address books some of which
>>are based on Access data. I use a 3rd-party product which each night
>>wipes out these address books, extracts the Access data and rebuilds
>>the address books. Works like a charm. I could no doubt write
>>something but as the product existed..... See
>>http://www.teamscope.com/otherpro/datalink.asp
>>
>>
>>Andy Lacey
>>http://www.minstersystems.co.uk
>>
>>
>>
>>>-----Original Message-----
>>>From: accessd-bounces at databaseadvisors.com
>>>[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Susan
>>>Harkins
>>>Sent: 22 January 2004 17:26
>>>To: AccessD at databaseadvisors.com
>>>Subject: [AccessD] modifying Outlook contact items from Access
>>>
>>>
>>>I'm familiar enough with the Outlook model that importing Contact
>>>data into Access is easy -- but I'm wondering if any of you use
>>>Access to actually modify Outlook contact information? I haven't even
>>>started, but would be interested in hearing how others do it. I know
>>>you can link, but that only works if Outlook is the default mail
>>>client.
>>>
>>>Susan H.
>>>
>>>_______________________________________________
>>>AccessD mailing list
>>>AccessD at databaseadvisors.com
>>>http://databaseadvisors.com/mailman/listinfo/a> ccessd
>>>Website:
>>>http://www.databaseadvisors.com
>>>
>>>
>>>
>>>
>>_______________________________________________
>>AccessD mailing list
>>AccessD at databaseadvisors.com
>>http://databaseadvisors.com/mailman/listinfo/accessd
>>Website: http://www.databaseadvisors.com
>>
>>
>>
>
>_______________________________________________
>AccessD mailing list
>AccessD at databaseadvisors.com
>http://databaseadvisors.com/mailman/listinfo/accessd
>Website: http://www.databaseadvisors.com
>
>
>
--
Marty Connelly
Victoria, B.C.
Canada
_______________________________________________
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com