Sending Contacts to Exchange Public Folder

I have the following code that exports contacts from my table 'main' to my default outlook contact folder.
I need to accomplish two things here.
1 - To update contacts rather than duplicating when running the function multiple times
2 - To send the contacts to a specified public folder rather than the default contact folder.

Dim dbs As Database
   Dim rst As Recordset
   Dim objOutlook As Outlook.Application
   Dim nms As Outlook.NameSpace
   Dim flds As Outlook.Folders
   Dim fldcontacts As Outlook.MAPIFolder
   'Dim fldContacts As Object
   Dim itms As Object
   Dim itm As Object
   Dim strCompany As String
   Dim strBusinessStreet As String
   Dim strBusinessStreet2 As String
   Dim strBusinessCity As String
   Dim strBusinessState As String
   Dim strBusinessZip As String
   Dim strBusinessPhone As String
   Dim strBusinessFax As String
   Dim strCategory As String
   Dim strCRLF As String
   Dim lngCount As Long
   Dim strID As String
     
   strCRLF = Chr$(13) & Chr$(10)
   
   Set objOutlook = CreateObject("Outlook.Application")
   Set nms = objOutlook.GetNamespace("MAPI")
   'Set fldcontacts = ("public folders/all public folders/streeter contacts")
   Set fldcontacts = nms.GetDefaultFolder(olFolderContacts)
   Set itms = fldcontacts.Items
   
   'Get reference to data table
   Set dbs = CurrentDb
   Set rst = dbs![Main].OpenRecordset(dbOpenTable, dbDenyRead)
   lngCount = rst.RecordCount
   MsgBox lngCount & " records to transfer to Outlook"

   'Loop through table, exporting each record to Outlook
   Do Until rst.EOF
      With rst
         'Pick up data from a record
         strCompany = Nz(![Company])
         strBusinessStreet = Nz(![BusinessStreet])
         strBusinessCity = Nz(![BusinessCity])
         strBusinessState = Nz(![BusinessState])
         strBusinessZip = Nz(![BusinessZip])
         strBusinessPhone = Nz(![BusinessPhone])
         strBusinessFax = Nz(![BusinessFax])
         strCategory = Nz(![Category])
         
      End With
     
      'Create a contact item
      Set itm = itms.Add("IPM.Contact")

     
      With itm
         .CompanyName = strCompany
         .BusinessAddressStreet = strBusinessStreet
         .BusinessAddressCity = strBusinessCity
         .BusinessAddressState = strBusinessState
         .BusinessAddressPostalCode = strBusinessZip
         .BusinessTelephoneNumber = strBusinessPhone
         .BusinessFaxNumber = strBusinessFax
         .Categories = strCategory
         .Close (olSave)
         DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
      End With
   rst.MoveNext
   Loop
   
   MsgBox "All Contacts exported!"
   
Exit_cmdPushData_Click:
   Exit Sub

Err_cmdPushData_Click:
   MsgBox Err.Description
   Resume Exit_cmdPushData_Click
End Sub

Any help is appreciated.