Looking for some assistance on a project that I am working on. I am new to VBA so please bear with me. I have designed a custom contact form in Outlook to accomodate a custom list of contact information into. I am using Access that has a table set up in it and a form with VBA code that prompts me for the contact folder that I want to export the data to. I found some sample code that I am working with and have tested my custom contact form with the sample code and it works fine. So I have modified the code on the Access form to add my custom fields and modify the database name that it needs to pull the information from. When I do this and run the command to export I get an Access error with the following description: Error No: 3265; Description: Item not found in Collection. I get the prompt that tells me how many contacts there are to import and the status bar starts but just stays in that same spot after the error message. My code that I am using is below. Does anyone have any ideas on what the problem would be and how to correct it? Any information is greatly appreciated, as I mentioned earlier I am very new to this whole scripting procedure
Option Compare Database
Option Explicit
'Declare the pfld variable as Public so it can be set in one procedure and used in another
Public pfld As Outlook.MAPIFolder
Dim appOutlook As Outlook.Application
Dim nms As Outlook.NameSpace
Private Sub cmdSelectFolder_Click()
Call SelectFolder
End Sub
Function SelectFolder()
On Error GoTo ErrorHandler
Set appOutlook = CreateObject("Outlook.Application")
Set nms = appOutlook.GetNamespace("MAPI")
SelectContactFolder:
Set pfld = nms.PickFolder
Debug.Print "Default item type: " & pfld.DefaultItemType
If pfld.DefaultItemType <> olContactItem Then
MsgBox "Please select a Contacts folder"
GoTo SelectContactFolder
End If
Forms![frmExportToOutlook].SetFocus
Me![txtFolderName].Value = pfld.Name
Me![LastContact].Value = ""
ErrorHandlerExit:
Exit Function
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Function
Private Sub cmdExport_Click()
On Error GoTo ErrorHandler
Dim dbs As Database
Dim rst As Recordset
Dim itms As Outlook.Items
Dim itm As Outlook.ContactItem
Dim strTitle As String
Dim strFirstName As String
Dim strMiddleName As String
Dim strLastName As String
Dim strSuffix As String
Dim strJobTitle As String
Dim strCompany As String
Dim strLastNameFirst As String
Dim strBusinessStreet As String
Dim strBusinessStreet2 As String
Dim strBusinessCity As String
Dim strBusinessState As String
Dim strBusinessPostalCode As String
Dim strBusinessCountry As String
Dim strBusinessPhone As String
Dim strBusinessFax As String
Dim strHomeStreet As String
Dim strHomeStreet2 As String
Dim strHomeCity As String
Dim strHomeState As String
Dim strHomePostalCode As String
Dim strHomeCountry As String
Dim strHomePhone As String
Dim strHomeFax As String
Dim strOtherStreet As String
Dim strOtherStreet2 As String
Dim strOtherCity As String
Dim strOtherState As String
Dim strOtherPostalCode As String
Dim strOtherCountry As String
Dim strOtherPhone As String
Dim strOtherFax As String
Dim strMobilePhone As String
Dim strEMailAddress As String
Dim strEMailAddress2 As String
Dim strContactID As String
Dim lngCount As Long
Dim strMessage As String
Dim lngResult As Long
Dim strContactForm As String
Dim strCategory As String
Dim varReturn As Variant
Dim lngPosition As Long
Dim dteBirthdate As Date
Dim dteSpouseBirthdate As Date
Dim strInvestmentAdvisor As String
Dim strBranch As String
Dim dteAnnualReview As Date
Dim dteAnnual As Date
Dim dteFirstQuarter As Date
Dim dteSecondQuarter As Date
Dim dteThirdQuarter As Date
Dim dteFourthQuarter As Date
Dim dteSemiAnnual1 As Date
Dim dteSemiAnnual2 As Date
Dim strCSINotes As String
'If Folder Name textbox is blank, call function to select folder
If Me![txtFolderName].Value = "" Then Call SelectFolder
Set itms = pfld.Items
'Set reference to Access table containing contact data
Set dbs = CurrentDb
Set rst = dbs![Csi].OpenRecordset(dbOpenTable, dbDenyRead)
lngCount = rst.RecordCount
strMessage = lngCount & " contact records to transfer to Outlook -- proceed?"
'Ask if user wants to proceed with the export
lngResult = MsgBox(strMessage, vbYesNo, "Proceed?")
'Exit if user says No
If lngResult = vbNo Then Exit Sub
'Pick up name of contact form from text box, with IPM.Contact.CSI CRM as a default in case the text box is blank. If this form (or any specified form) is not available, the standard Contact form will be used instead
strContactForm = Nz(Me![txtContactForm], "IPM.Contact.CSI CRM")
'Pick up category from text box, allowing a blank category
strCategory = Nz(Me![txtCategory])
'Turn on hourglass and initialize status bar to show progress of the export
DoCmd.Hourglass True
strMessage = "Exporting " & lngCount & " records to Outlook"
varReturn = Application.SysCmd(acSysCmdInitMeter, strMessage, lngCount)
Me![LastContact].Value = ""
'Loop through the Access table, exporting each record to Outlook
'The Nz function is used to convert blanks into zeros or zero-length strings, in some cases supplying default values
'The vbCrLf constant represents a carriage return + linefeed
For lngPosition = 1 To lngCount
With rst
'Set variables to data from a record
strContactID = Nz(![CustomerID])
strTitle = Nz(![Title])
strFirstName = Nz(![FirstName])
strMiddleName = Nz(![MiddleName])
strLastName = Nz(![LastName])
strSuffix = Nz(![Suffix])
strJobTitle = Nz(![JobTitle])
strCompany = Nz(![Company])
strLastNameFirst = Nz(![LastName]) & ", " & Nz(![FirstName])
strBusinessStreet = Nz(![BusinessStreet1]) & IIf(Nz(![BusinessStreet2]) <> "", vbCrLf & Nz(![BusinessStreet2]), "")
strBusinessCity = Nz(![BusinessCity])
strBusinessState = Nz(![BusinessState])
strBusinessPostalCode = Nz(![BusinessPostalCode])
strBusinessCountry = Nz(![BusinessCountry])
strBusinessPhone = Nz(![BusinessPhone])
strBusinessFax = Nz(![BusinessFax])
strHomeStreet = Nz(![HomeStreet1]) & IIf(Nz(![HomeStreet2]) <> "", vbCrLf & Nz(![HomeStreet2]), "")
strHomeCity = Nz(![HomeCity])
strHomeState = Nz(![HomeState])
strHomePostalCode = Nz(![HomePostalCode])
strHomeCountry = Nz(![HomeCountry])
strHomePhone = Nz(![HomePhone])
strHomeFax = Nz(![HomeFax])
strOtherStreet = Nz(![OtherStreet1]) & IIf(Nz(![OtherStreet2]) <> "", vbCrLf & Nz(![OtherStreet2]), "")
strOtherCity = Nz(![OtherCity])
strOtherState = Nz(![OtherState])
strOtherPostalCode = Nz(![OtherPostalCode])
strOtherCountry = Nz(![OtherCountry])
strOtherPhone = Nz(![OtherPhone])
strOtherFax = Nz(![OtherFax])
strMobilePhone = Nz(![MobilePhone])
strEMailAddress = Nz(![E-mailAddress])
strEMailAddress2 = Nz(![E-mail2Address])
'1/1/4501 is the way Outlook stores a blank date
'dteLastVisit = Nz(![LastVisit], #1/1/4501#)
'intNoChildren = Nz(![NumberChildren])
'strCustomerType = Nz(![CustomerType], "Standard")
dteBirthdate = Nz(![Birthdate])
dteSpouseBirthdate = Nz(![SpouseBirthdate])
strInvestmentAdvisor = Nz(![InvestmentAdvisor])
strBranch = Nz(![Branch])
dteAnnualReview = Nz(![AnnualReview])
dteAnnual = Nz(![Annual])
dteFirstQuarter = Nz(![FirstQuarter])
dteSecondQuarter = Nz(![SecondQuarter])
dteThirdQuarter = Nz(![ThirdQuarter])
dteFourthQuarter = Nz(![FourthQuarter])
dteSemiAnnual1 = Nz(![SemiAnnual1])
dteSemiAnnual2 = Nz(![SemiAnnual2])
strCSINotes = Nz(![CSINotes])
End With
'Create a contact item
Set itm = itms.Add(strContactForm)
'Write values from variables to fields in the new Contact item
With itm
'Standard Contact fields
.CustomerID = strContactID
.Title = strTitle
.FirstName = strFirstName
.MiddleName = strMiddleName
.LastName = strLastName
.Suffix = strSuffix
.JobTitle = strJobTitle
.CompanyName = strCompany
.BusinessAddressStreet = strBusinessStreet
.BusinessAddressCity = strBusinessCity
.BusinessAddressState = strBusinessState
.BusinessAddressPostalCode = strBusinessPostalCode
.BusinessAddressCountry = strBusinessCountry
.BusinessTelephoneNumber = strBusinessPhone
.BusinessFaxNumber = strBusinessFax
.HomeAddressStreet = strHomeStreet
.HomeAddressCity = strHomeCity
.HomeAddressState = strHomeState
.HomeAddressPostalCode = strHomePostalCode
.HomeAddressCountry = strHomeCountry
.HomeTelephoneNumber = strHomePhone
.HomeFaxNumber = strHomeFax
.OtherAddressStreet = strOtherStreet
.OtherAddressCity = strOtherCity
.OtherAddressState = strOtherState
.OtherAddressPostalCode = strOtherPostalCode
.OtherAddressCountry = strOtherCountry
.OtherTelephoneNumber = strOtherPhone
.OtherFaxNumber = strOtherFax
.MobileTelephoneNumber = strMobilePhone
.Email1Address = strEMailAddress
.Email2Address = strEMailAddress2
.Categories = strCategory
'Custom fields -- modify as needed for your custom form
'The Debug.Print statements are for debugging possible problems
'Debug.Print "Writing " & dteLastVisit & " to Last Visit field"
'.UserProperties("LastVisit") = dteLastVisit
'Debug.Print "Writing " & intNoChildren & " to Number Children field"
'.UserProperties("NumberChildren") = intNoChildren
'Debug.Print "Writing " & strCustomerType & " to Customer Type field"
'.UserProperties("CustomerType") = strCustomerType
Debug.Print "Writing " & dteBirthdate & " to Birthdate field"
.UserProperties("Birthdate") = dteBirthdate
Debug.Print "Writing " & dteSpouseBirthdate & " to Spouse Birthdate field"
.UserProperties("SpouseBirthdate") = dteSpouseBirthdate
Debug.Print "Writing " & strInvestmentAdvisor & " to Investment Advisor field"
.UserProperties("InvestmentAdvisor") = strInvestmentAdvisor
Debug.Print "Writing " & strBranch & " to Branch field"
.UserProperties("Branch") = strBranch
Debug.Print "Writing " & dteAnnualReview & " to Annual Review field"
.UserProperties("AnnualReview") = dteAnnualReview
Debug.Print "Writing " & dteAnnual & " to Annual field"
.UserProperties("Annual") = dteAnnual
Debug.Print "Writing " & dteFirstQuarter & " to First Quarter field"
.UserProperties("FirstQuarter") = dteFirstQuarter
Debug.Print "Writing " & dteSecondQuarter & " to Second Quarter field"
.UserProperties("SecondQuarter") = dteSecondQuarter
Debug.Print "Writing " & dteThirdQuarter & " to Third Quarter field"
.UserProperties("ThirdQuarter") = dteThirdQuarter
Debug.Print "Writing " & dteFourthQuarter & " to Fourth Quarter field"
.UserProperties("FourthQuarter") = dteFourthQuarter
Debug.Print "Writing " & dteSemiAnnual1 & " to SemiAnnual1 field"
.UserProperties("SemiAnnual1") = dteSemiAnnual1
Debug.Print "Writing " & dteSemiAnnual2 & " to SemiAnnual2 field"
.UserProperties("SemiAnnual2") = dteSemiAnnual2
Debug.Print "Writing " & strCSINotes & " to CSINotes field"
.UserProperties("CSINotes") = strCSINotes
'Close and save new contact item
.Close (olSave)
DoCmd.RunCommand acCmdSaveRecord
'Update status bar with progress
varReturn = Application.SysCmd(acSysCmdUpdateMeter, lngPosition)
'Write information about contact just processed to a textbox on the form
Me![LastContact] = strContactID & " -- " & strLastNameFirst
End With
rst.MoveNext
Next lngPosition
'Clear status bar and turn off hourglass
varReturn = Application.SysCmd(acSysCmdClearStatus)
DoCmd.Hourglass False
MsgBox "All Contacts exported!"
Me![txtLastContact].Requery
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub cmdQuit_Click()
On Error GoTo ErrorHandler
Application.Quit
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub Form_Load()
On Error GoTo ErrorHandler
DoCmd.RunCommand acCmdSizeToFitForm
Me![ContactForm] = "IPM.Contact.CSI CRM"
Me![LastContact] = ""
Me![FolderName] = ""
Me![Category] = ""
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Thanks
pockets
Option Compare Database
Option Explicit
'Declare the pfld variable as Public so it can be set in one procedure and used in another
Public pfld As Outlook.MAPIFolder
Dim appOutlook As Outlook.Application
Dim nms As Outlook.NameSpace
Private Sub cmdSelectFolder_Click()
Call SelectFolder
End Sub
Function SelectFolder()
On Error GoTo ErrorHandler
Set appOutlook = CreateObject("Outlook.Application")
Set nms = appOutlook.GetNamespace("MAPI")
SelectContactFolder:
Set pfld = nms.PickFolder
Debug.Print "Default item type: " & pfld.DefaultItemType
If pfld.DefaultItemType <> olContactItem Then
MsgBox "Please select a Contacts folder"
GoTo SelectContactFolder
End If
Forms![frmExportToOutlook].SetFocus
Me![txtFolderName].Value = pfld.Name
Me![LastContact].Value = ""
ErrorHandlerExit:
Exit Function
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Function
Private Sub cmdExport_Click()
On Error GoTo ErrorHandler
Dim dbs As Database
Dim rst As Recordset
Dim itms As Outlook.Items
Dim itm As Outlook.ContactItem
Dim strTitle As String
Dim strFirstName As String
Dim strMiddleName As String
Dim strLastName As String
Dim strSuffix As String
Dim strJobTitle As String
Dim strCompany As String
Dim strLastNameFirst As String
Dim strBusinessStreet As String
Dim strBusinessStreet2 As String
Dim strBusinessCity As String
Dim strBusinessState As String
Dim strBusinessPostalCode As String
Dim strBusinessCountry As String
Dim strBusinessPhone As String
Dim strBusinessFax As String
Dim strHomeStreet As String
Dim strHomeStreet2 As String
Dim strHomeCity As String
Dim strHomeState As String
Dim strHomePostalCode As String
Dim strHomeCountry As String
Dim strHomePhone As String
Dim strHomeFax As String
Dim strOtherStreet As String
Dim strOtherStreet2 As String
Dim strOtherCity As String
Dim strOtherState As String
Dim strOtherPostalCode As String
Dim strOtherCountry As String
Dim strOtherPhone As String
Dim strOtherFax As String
Dim strMobilePhone As String
Dim strEMailAddress As String
Dim strEMailAddress2 As String
Dim strContactID As String
Dim lngCount As Long
Dim strMessage As String
Dim lngResult As Long
Dim strContactForm As String
Dim strCategory As String
Dim varReturn As Variant
Dim lngPosition As Long
Dim dteBirthdate As Date
Dim dteSpouseBirthdate As Date
Dim strInvestmentAdvisor As String
Dim strBranch As String
Dim dteAnnualReview As Date
Dim dteAnnual As Date
Dim dteFirstQuarter As Date
Dim dteSecondQuarter As Date
Dim dteThirdQuarter As Date
Dim dteFourthQuarter As Date
Dim dteSemiAnnual1 As Date
Dim dteSemiAnnual2 As Date
Dim strCSINotes As String
'If Folder Name textbox is blank, call function to select folder
If Me![txtFolderName].Value = "" Then Call SelectFolder
Set itms = pfld.Items
'Set reference to Access table containing contact data
Set dbs = CurrentDb
Set rst = dbs![Csi].OpenRecordset(dbOpenTable, dbDenyRead)
lngCount = rst.RecordCount
strMessage = lngCount & " contact records to transfer to Outlook -- proceed?"
'Ask if user wants to proceed with the export
lngResult = MsgBox(strMessage, vbYesNo, "Proceed?")
'Exit if user says No
If lngResult = vbNo Then Exit Sub
'Pick up name of contact form from text box, with IPM.Contact.CSI CRM as a default in case the text box is blank. If this form (or any specified form) is not available, the standard Contact form will be used instead
strContactForm = Nz(Me![txtContactForm], "IPM.Contact.CSI CRM")
'Pick up category from text box, allowing a blank category
strCategory = Nz(Me![txtCategory])
'Turn on hourglass and initialize status bar to show progress of the export
DoCmd.Hourglass True
strMessage = "Exporting " & lngCount & " records to Outlook"
varReturn = Application.SysCmd(acSysCmdInitMeter, strMessage, lngCount)
Me![LastContact].Value = ""
'Loop through the Access table, exporting each record to Outlook
'The Nz function is used to convert blanks into zeros or zero-length strings, in some cases supplying default values
'The vbCrLf constant represents a carriage return + linefeed
For lngPosition = 1 To lngCount
With rst
'Set variables to data from a record
strContactID = Nz(![CustomerID])
strTitle = Nz(![Title])
strFirstName = Nz(![FirstName])
strMiddleName = Nz(![MiddleName])
strLastName = Nz(![LastName])
strSuffix = Nz(![Suffix])
strJobTitle = Nz(![JobTitle])
strCompany = Nz(![Company])
strLastNameFirst = Nz(![LastName]) & ", " & Nz(![FirstName])
strBusinessStreet = Nz(![BusinessStreet1]) & IIf(Nz(![BusinessStreet2]) <> "", vbCrLf & Nz(![BusinessStreet2]), "")
strBusinessCity = Nz(![BusinessCity])
strBusinessState = Nz(![BusinessState])
strBusinessPostalCode = Nz(![BusinessPostalCode])
strBusinessCountry = Nz(![BusinessCountry])
strBusinessPhone = Nz(![BusinessPhone])
strBusinessFax = Nz(![BusinessFax])
strHomeStreet = Nz(![HomeStreet1]) & IIf(Nz(![HomeStreet2]) <> "", vbCrLf & Nz(![HomeStreet2]), "")
strHomeCity = Nz(![HomeCity])
strHomeState = Nz(![HomeState])
strHomePostalCode = Nz(![HomePostalCode])
strHomeCountry = Nz(![HomeCountry])
strHomePhone = Nz(![HomePhone])
strHomeFax = Nz(![HomeFax])
strOtherStreet = Nz(![OtherStreet1]) & IIf(Nz(![OtherStreet2]) <> "", vbCrLf & Nz(![OtherStreet2]), "")
strOtherCity = Nz(![OtherCity])
strOtherState = Nz(![OtherState])
strOtherPostalCode = Nz(![OtherPostalCode])
strOtherCountry = Nz(![OtherCountry])
strOtherPhone = Nz(![OtherPhone])
strOtherFax = Nz(![OtherFax])
strMobilePhone = Nz(![MobilePhone])
strEMailAddress = Nz(![E-mailAddress])
strEMailAddress2 = Nz(![E-mail2Address])
'1/1/4501 is the way Outlook stores a blank date
'dteLastVisit = Nz(![LastVisit], #1/1/4501#)
'intNoChildren = Nz(![NumberChildren])
'strCustomerType = Nz(![CustomerType], "Standard")
dteBirthdate = Nz(![Birthdate])
dteSpouseBirthdate = Nz(![SpouseBirthdate])
strInvestmentAdvisor = Nz(![InvestmentAdvisor])
strBranch = Nz(![Branch])
dteAnnualReview = Nz(![AnnualReview])
dteAnnual = Nz(![Annual])
dteFirstQuarter = Nz(![FirstQuarter])
dteSecondQuarter = Nz(![SecondQuarter])
dteThirdQuarter = Nz(![ThirdQuarter])
dteFourthQuarter = Nz(![FourthQuarter])
dteSemiAnnual1 = Nz(![SemiAnnual1])
dteSemiAnnual2 = Nz(![SemiAnnual2])
strCSINotes = Nz(![CSINotes])
End With
'Create a contact item
Set itm = itms.Add(strContactForm)
'Write values from variables to fields in the new Contact item
With itm
'Standard Contact fields
.CustomerID = strContactID
.Title = strTitle
.FirstName = strFirstName
.MiddleName = strMiddleName
.LastName = strLastName
.Suffix = strSuffix
.JobTitle = strJobTitle
.CompanyName = strCompany
.BusinessAddressStreet = strBusinessStreet
.BusinessAddressCity = strBusinessCity
.BusinessAddressState = strBusinessState
.BusinessAddressPostalCode = strBusinessPostalCode
.BusinessAddressCountry = strBusinessCountry
.BusinessTelephoneNumber = strBusinessPhone
.BusinessFaxNumber = strBusinessFax
.HomeAddressStreet = strHomeStreet
.HomeAddressCity = strHomeCity
.HomeAddressState = strHomeState
.HomeAddressPostalCode = strHomePostalCode
.HomeAddressCountry = strHomeCountry
.HomeTelephoneNumber = strHomePhone
.HomeFaxNumber = strHomeFax
.OtherAddressStreet = strOtherStreet
.OtherAddressCity = strOtherCity
.OtherAddressState = strOtherState
.OtherAddressPostalCode = strOtherPostalCode
.OtherAddressCountry = strOtherCountry
.OtherTelephoneNumber = strOtherPhone
.OtherFaxNumber = strOtherFax
.MobileTelephoneNumber = strMobilePhone
.Email1Address = strEMailAddress
.Email2Address = strEMailAddress2
.Categories = strCategory
'Custom fields -- modify as needed for your custom form
'The Debug.Print statements are for debugging possible problems
'Debug.Print "Writing " & dteLastVisit & " to Last Visit field"
'.UserProperties("LastVisit") = dteLastVisit
'Debug.Print "Writing " & intNoChildren & " to Number Children field"
'.UserProperties("NumberChildren") = intNoChildren
'Debug.Print "Writing " & strCustomerType & " to Customer Type field"
'.UserProperties("CustomerType") = strCustomerType
Debug.Print "Writing " & dteBirthdate & " to Birthdate field"
.UserProperties("Birthdate") = dteBirthdate
Debug.Print "Writing " & dteSpouseBirthdate & " to Spouse Birthdate field"
.UserProperties("SpouseBirthdate") = dteSpouseBirthdate
Debug.Print "Writing " & strInvestmentAdvisor & " to Investment Advisor field"
.UserProperties("InvestmentAdvisor") = strInvestmentAdvisor
Debug.Print "Writing " & strBranch & " to Branch field"
.UserProperties("Branch") = strBranch
Debug.Print "Writing " & dteAnnualReview & " to Annual Review field"
.UserProperties("AnnualReview") = dteAnnualReview
Debug.Print "Writing " & dteAnnual & " to Annual field"
.UserProperties("Annual") = dteAnnual
Debug.Print "Writing " & dteFirstQuarter & " to First Quarter field"
.UserProperties("FirstQuarter") = dteFirstQuarter
Debug.Print "Writing " & dteSecondQuarter & " to Second Quarter field"
.UserProperties("SecondQuarter") = dteSecondQuarter
Debug.Print "Writing " & dteThirdQuarter & " to Third Quarter field"
.UserProperties("ThirdQuarter") = dteThirdQuarter
Debug.Print "Writing " & dteFourthQuarter & " to Fourth Quarter field"
.UserProperties("FourthQuarter") = dteFourthQuarter
Debug.Print "Writing " & dteSemiAnnual1 & " to SemiAnnual1 field"
.UserProperties("SemiAnnual1") = dteSemiAnnual1
Debug.Print "Writing " & dteSemiAnnual2 & " to SemiAnnual2 field"
.UserProperties("SemiAnnual2") = dteSemiAnnual2
Debug.Print "Writing " & strCSINotes & " to CSINotes field"
.UserProperties("CSINotes") = strCSINotes
'Close and save new contact item
.Close (olSave)
DoCmd.RunCommand acCmdSaveRecord
'Update status bar with progress
varReturn = Application.SysCmd(acSysCmdUpdateMeter, lngPosition)
'Write information about contact just processed to a textbox on the form
Me![LastContact] = strContactID & " -- " & strLastNameFirst
End With
rst.MoveNext
Next lngPosition
'Clear status bar and turn off hourglass
varReturn = Application.SysCmd(acSysCmdClearStatus)
DoCmd.Hourglass False
MsgBox "All Contacts exported!"
Me![txtLastContact].Requery
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub cmdQuit_Click()
On Error GoTo ErrorHandler
Application.Quit
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Private Sub Form_Load()
On Error GoTo ErrorHandler
DoCmd.RunCommand acCmdSizeToFitForm
Me![ContactForm] = "IPM.Contact.CSI CRM"
Me![LastContact] = ""
Me![FolderName] = ""
Me![Category] = ""
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End Sub
Thanks
pockets
