Its a function, placed in a module.
When i build on the command button - =UpdatetblContacts() it will not save the command. Doesnt like it for some reason!!
-----------------
Option Compare Database
Function UpdatetblContacts() As String
MsgBox "running"
'set the recordset names
'Fullname is for comparing names between two tables
'numrec counts the newly added records
Dim dbs As Database
Dim rstContacts As Recordset
Dim rstOutlook As Recordset
Dim FullName As String
Dim numrec As Integer
Set dbs = CurrentDb
'set to each rst to a table. Must be a dynaset (I think)
Set rstOutlook = dbs.OpenRecordset("tblOutlookLink", dbOpenDynaset)
Set rstContacts = dbs.OpenRecordset("tblContacts", dbOpenDynaset)
'Move to the first record in the outlook table.
rstOutlook.MoveFirst
'Do until end of the outlook table
Do Until rstOutlook.EOF = True
'Set the var fullname to match the first and last name on outlook table.
'However, if there is no last name then it must just copy the first. Doing
'otherwise will cause a duplicate PK and return an error. The code
'below fixes this by telling it to only add first name if last name is blank
If rstOutlook!Last = "" Or IsNull(rstOutlook!Last) Then
FullName = "[First]=""" & rstOutlook!First & """"
Else
FullName = "[First]=""" & rstOutlook!First & """ AND [Last] =""" & rstOutlook!Last & """"
End If
'find the first match
rstContacts.FindFirst FullName
'if no match then add a new record
If rstContacts.NoMatch Then
rstContacts.AddNew
'if the last name field is blank then only add first name as fullname
'otherwise fullname is both
If rstOutlook!Last = "" Or IsNull(rstOutlook!Last) Then
rstContacts!FullName = rstOutlook!First & " "
rstContacts!First = rstOutlook!First
Else
rstContacts!FullName = rstOutlook!First & " " & rstOutlook!Last
rstContacts!First = rstOutlook!First
rstContacts!Last = rstOutlook!Last
End If
rstContacts!JobTitle = rstOutlook![Job Title]
'if company is blank then organisation just = company, otherwise its both
'this is due to department default val being "." even if no company
'if this code was not used then an organisation of " - . " would be created.
If rstOutlook!Company = "" Or IsNull(rstOutlook!Company) Then
rstContacts!Organisation = rstOutlook!Company
Else
rstContacts!Organisation = rstOutlook!Company & " " & rstOutlook!Department
End If
rstContacts!Email = rstOutlook![Email Address]
rstContacts!OfficePhone = rstOutlook!Phone
rstContacts!OfficeFax = rstOutlook![Business Fax]
rstContacts!OutHoursPhone = rstOutlook![Home Phone]
rstContacts!OutHoursFax = rstOutlook![Home Fax]
rstContacts!Mobile = rstOutlook![Mobile Phone]
rstContacts!Pager = rstOutlook![Pager Phone]
rstContacts.Update
'add 1 to the count
numrec = numrec + 1
Else
'otherwise update the record if a match is returned
rstContacts.Edit
'if the last name field is blank then only add first name as fullname
'otherwise fullname is both
If rstOutlook!Last = "" Or IsNull(rstOutlook!Last) Then
rstContacts!FullName = rstOutlook!First & " "
rstContacts!First = rstOutlook!First
Else
rstContacts!FullName = rstOutlook!First & " " & rstOutlook!Last
rstContacts!First = rstOutlook!First
rstContacts!Last = rstOutlook!Last
End If
rstContacts!JobTitle = rstOutlook![Job Title]
'if company is blank then organisation just = company, otherwise its both
'this is due to department default val being "." even if no company
'if this code was not used then an organisation of " - . " would be created.
If rstOutlook!Company = "" Or IsNull(rstOutlook!Company) Then
rstContacts!Organisation = rstOutlook!Company
Else
rstContacts!Organisation = rstOutlook!Company & " " & rstOutlook!Department
End If
rstContacts!Email = rstOutlook![Email Address]
rstContacts!OfficePhone = rstOutlook!Phone
rstContacts!OfficeFax = rstOutlook![Business Fax]
rstContacts!OutHoursPhone = rstOutlook![Home Phone]
rstContacts!OutHoursFax = rstOutlook![Home Fax]
rstContacts!Mobile = rstOutlook![Mobile Phone]
rstContacts!Pager = rstOutlook![Pager Phone]
rstContacts.Update
End If
'Move to next record
rstOutlook.MoveNext
'return to start of the loop
Loop
'Confirm code has finished running
MsgBox numrec & " new contacts have been added. All current contacts have been checked and details updated"
'close recordsets
rstContacts.Close
rstOutlook.Close
Set dbs = Nothing
End Function