John,
I did it. I found out what the problem was. well, there were a few of
them. At any rate, if you're interested here's the working code that I'm
using:
Function CheckNull(s As Variant) As Variant
On Error Resume Next
If IsNull(s) Then
CheckNull = ""
Else
CheckNull = s
End If
End Function
Public Sub cmdSync_Click()
Dim objFolder As Outlook.MAPIFolder
Dim rstCust As DAO.Recordset
Dim cnnDB As DAO.Database
Dim oContactsFolder As Outlook.MAPIFolder
Dim oNameSpace As NameSpace
Dim oApp As Outlook.Application
Dim oContact As Outlook.ContactItem
Dim syncSuccess As Boolean
Dim strFileAs As String
Dim strFullName As String
Dim intRecordCount As Integer
DoCmd.Hourglass True
Set cnnDB = CurrentDb()
Set rstCust = cnnDB.OpenRecordset("Select * From qrySynchronize")
Set oApp = CreateObject("Outlook.Application")
Set oNameSpace = oApp.GetNamespace("MAPI")
Set objFolder = oNameSpace.GetDefaultFolder(olFolderContacts)
intRecordCount = 0
'Create the FSR Tracking Contacts folder under the default contacts
folder. If the folder already exists, move on.
On Error Resume Next
Set oContactsFolder = objFolder.Folders.Add("FSR Tracking Contacts",
olFolderContacts)
On Error GoTo CreateContacts_Error
'Delete Existing Items
Set oContactsFolder = objFolder.Folders("FSR Tracking Contacts")
If oContactsFolder.Items.Count > 0 Then
Do Until oContactsFolder.Items.Count = 0
oContactsFolder.Items.Remove (1)
Loop
End If
'Create New Contact Items
With rstCust
If Not .BOF Or .EOF Then
Do Until .EOF
strFileAs = rstCust!LastName & ", " & rstCust!FirstName
strFullName = rstCust!FirstName & " " & rstCust!LastName
Set oContact = oContactsFolder.Items.Add(olContactItem)
'CheckNull replaces database Nulls with empty string
oContact.FirstName = CheckNull(rstCust!FirstName)
oContact.LastName = CheckNull(rstCust!LastName)
oContact.BusinessTelephoneNumber = CheckNull(rstCust!WPhone)
oContact.HomeTelephoneNumber = CheckNull(rstCust!HPhone)
oContact.MobileTelephoneNumber = CheckNull(rstCust!CPhone)
oContact.PagerNumber = CheckNull(rstCust!Pager)
oContact.BusinessFaxNumber = CheckNull(rstCust!Fax)
oContact.Email1Address = CheckNull(rstCust!Email)
oContact.HomeAddress = CheckNull(rstCust!HAddress)
oContact.HomeAddressCity = CheckNull(rstCust!HCity)
oContact.HomeAddressState = CheckNull(rstCust!HState)
oContact.HomeAddressPostalCode = CheckNull(rstCust!HZip)
oContact.OtherAddress = CheckNull(rstCust!PAddress)
oContact.OtherAddressCity = CheckNull(rstCust!PCity)
oContact.OtherAddressState = CheckNull(rstCust!PState)
oContact.OtherAddressPostalCode = CheckNull(rstCust!PZip)
oContact.FileAs = CheckNull(strFileAs)
oContact.FullName = CheckNull(strFullName)
oContact.JobTitle = CheckNull(rstCust!Title)
oContact.Categories = "FSR Tracking Contacts"
oContact.Save
intRecordCount = intRecordCount + 1
.MoveNext
Loop
.Close
End If
End With
DoCmd.Hourglass False
syncSuccess = True
CreateContacts_Exit:
If syncSuccess = True Then
MsgBox "Synchronization was successful" & vbCr & intRecordCount & "
Records Loaded", vbInformation
End If
Exit Sub
CreateContacts_Error:
MsgBox "Error#: " & Err.Number & vbCr & Err.Description, vbInformation
syncSuccess = False
GoTo CreateContacts_Exit
End Sub
John Nurick said:
Jonathan,
That syntax looks just fine.
Does qrySynchronize work properly when you double-click it in the
database window? If not, fix it. But if it does work there, then
OpenRecordset("Select * from qrySynchronize") should work too.
If the query works OK but
Set rstCust = currentDb.OpenRecordset("Select * from qrySynchronize")
raises a type mismatch error, I don't quite know what's happening. I
guess that if your database is an ADP you'd need to
Dim rstCust As New ADODB.Recordset
...
rstCust.Open "SELECT * FROM qrySynchronize;", MyConnection...
Also, check for reference errors. See
http://members.rogers.com/douglas.j.steele/AccessReferenceErrors.html
for details.
Oh, sorry about that John. The line that is highlighted in yellow when I
click the debug button is the line where I set my Recordset.
Set rstCust = currentDb.OpenRecordset("Select * from qrySynchronize")
The sql statement for the qrySynchronize query is as follows:
SELECT tblFSRInfo.FirstName, tblFSRInfo.LastName, tblFSRInfo.Title,
tblFSRInfo.Bdate, tblFSRInfo.HPhone, tblFSRInfo.WPhone, tblFSRInfo.CPhone,
tblFSRInfo.Pager, tblFSRInfo.Fax, tblFSRInfo.Email, tblFSRInfo.HAddress,
tblFSRInfo.HCity, tblFSRInfo.HState, tblFSRInfo.HZip, tblFSRInfo.PAddress,
tblFSRInfo.PCity, tblFSRInfo.PState, tblFSRInfo.PZip, [LastName] & " " &
[Firstname] AS FileAs, [FirstName] & " " & [LastName] AS FullName
FROM tblFSRInfo;
Because I don't have a FileAs field or a FullName field in my tblFSRInfo I
had to create a query and just create these concatenated fields. Do you
think that might be the issue?
Thanks again John.
:
There's no way I'm going to look through this code if you don't tell me
which line raises the error.
On Sat, 19 Feb 2005 18:31:03 -0800, "Jonathan Brown"
Hi John,
Thanks for you reply. I've been working on this task for quite a while now.
I think I'm rather close to coming up with a solution. Below is the code
that I have thus far. It seems the last hoop I need to jump though is
figuring out how to solve an error message I'm getting. I'm getting a Type
Mismatch error. If you have a chance, let me know if you see anything that
stands out.
Okay everyone, or anyone who's reading this, I've made some more progress. I
found out that my main issue was that my recordset was not defined properly.
Here's the code that I have now:
Function CheckNull(s As Variant) As Variant
On Error Resume Next
If IsNull(s) Then
CheckNull = ""
Else
CheckNull = s
End If
End Function
Public Sub cmdSync_Click()
Dim objFolder As Outlook.MAPIFolder
Dim rstCust As DAO.Recordset
Dim oContactsFolder As Outlook.MAPIFolder
Dim oNameSpace As NameSpace
Dim oApp As Outlook.Application
Dim oContact As Outlook.ContactItem
Dim syncSuccess As Boolean
DoEvents
Set rstCust = CurrentDb.OpenRecordset("Select * from qrySynchronize")
Set oApp = CreateObject("Outlook.Application")
Set oNameSpace = oApp.GetNamespace("MAPI")
Set objFolder = oNameSpace.GetDefaultFolder(olFolderContacts)
'Create the FSR Tracking Contacts folder under the default contacts
folder. If the folder already exists, move on.
On Error Resume Next
Me.lblSyncStatus.Caption = "Creating FSR Tracking Contacts Folder"
Set oContactsFolder = objFolder.Folders.Add("FSR Tracking Contacts",
olFolderContacts)
On Error GoTo CreateContacts_Error
'Delete Existing Items
Me.lblSyncStatus.Caption = "Removing existing items, please wait..."
Do Until oContactsFolder.Items.Count = 0
oContactsFolder.Items.Remove (1)
Loop
'Create New Contact Items
Do Until rstCust.EOF
Set oContact = oContactsFolder.Items.Add(olContactItem)
'CheckNull replaces database Nulls with empty string
oContact.FirstName = CheckNull(rstCust!FirstName)
oContact.LastName = CheckNull(rstCust!LastName)
oContact.BusinessTelephoneNumber = CheckNull(rstCust!WPhone)
oContact.HomeTelephoneNumber = CheckNull(rstCust!HPhone)
oContact.MobileTelephoneNumber = CheckNull(rstCust!CPhone)
oContact.PagerNumber = CheckNull(rstCust!Pager)
oContact.Birthday = CheckNull(rstCust!Bdate)
oContact.BusinessFaxNumber = CheckNull(rstCust!Fax)
oContact.Email1Address = CheckNull(rstCust!Email)
oContact.HomeAddress = CheckNull(rstCust!HAddress)
oContact.HomeAddressCity = CheckNull(rstCust!HCity)
oContact.HomeAddressState = CheckNull(rstCust!HState)
oContact.HomeAddressPostalCode = CheckNull(rstCust!HZip)
oContact.OtherAddress = CheckNull(rstCust!PAddress)
oContact.OtherAddressCity = CheckNull(rstCust!PCity)
oContact.OtherAddressState = CheckNull(rstCust!PState)
oContact.OtherAddressPostalCode = CheckNull(rstCust!PZip)
oContact.FileAs = CheckNull(rstCust!FileAs)
oContact.FullName = CheckNull(rstCust!FullName)
oContact.JobTitle = CheckNull(rstCust!Title)
oContact.Save
Me.lblSyncStatus.Caption = "Loading " & CheckNull(rstCust!FullName)
rstCust.MoveNext
DoEvents
Loop
syncSuccess = True
Resume CreateContacts_Exit
CreateContacts_Exit:
On Error Resume Next
rstCust.Close
Me.lblSyncStatus.Caption = ""
If syncSuccess = True Then
MsgBox "Synchronization was successful", vbInformation
End If
Exit Sub
CreateContacts_Error:
MsgBox "Error#: " & Err.Number & vbCr & Err.Description, vbInformation
syncSuccess = False
Resume CreateContacts_Exit
End Sub
:
Hi Jonathan,
There's no way I know of doing this directly. The first thing I'd check
is whether the Blackberry software can synchronise with ODBC data
sources (i.e. including Access).
Otherwise, I'd set about writing code that automates Outlook to create a
PST file with a Contacts folder, and then creates a contact
corresponding to each record in the Access query. This could run in
Outlook, Access or probably even the Windows script engine as
convenient.
On Tue, 18 Jan 2005 14:51:04 -0800, "Jonathan Brown"
I have a database that keeps track of contacts. Is there I way I can export
a query as a Personal Address Book or .pst file? My main intention is to
synchronize the database with a blackberry pda. Any suggestions would be
greatly appreciated.
Jonathan
