Import contacts into public folder in Exchange

[gkbren]

I am writing a program (VB6) to import contacts into several public folders. I am getting a Error 6 - Overflow if I try to process more than about 325 records. (Works fine on less than 300 records.)

I am using ADO to create the link to the Exchange Public Folder and reading the names from a CSV file. I am using code from

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnmes2k/html/cwswp_0001.asp

to process the records.

If someone thinks they can help and they need more of the code, please let me know and I'd be glad to post. I need to be able to process 1600 records and I could just run the program 3 times, but I'd like to get this fixed.

Thanks,
GK Bren

 

[paulbent]

Can you identify which line the error occurs on and post the relevant part of the code. Are you running this app server side?

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[gkbren]

Sorry it's taken me so long to get back. Yes, this is a server side app.

What took so long is that I was trying to pare down the code and see if I could spot where the problem is. I am currently importing 39 fields of information. When I reduced the number of fields, I was able to import more records.

Because the program has to run on a separate computer that has Exchange and not the one where I have my development tools, it's hard to find where the break occurs. (The only way I know is to put in msgbox lines and watch it cycle--any other debugging tips?)

Below is the code from the main module.

Any help is greatly appreciated.
---

Option Explicit
Public arrsubstring() As String
Public sURL As String
Public bFound As Boolean
Public strFolder As String
Public txtFile
Public oPer
Public bFlagImportOnly As Boolean 'flag from Form1 to import only

'modified gbren 10/6/03

'** Error constants used in this module
Private Const ERR_CONTACT_NOT_FOUND As Long = &H80040E19

'This module is designed to take a CSV file, read a line, separate into an array,
'then check to see if the value exists in an Exchange folder. If it does, it modifies
'the fields, if it does not, it adds it.
'4-14-03 Change made to import into a folder using DSM number


Sub PopulateArray2()
'when csv, will need to open file
Dim fs, f, ts, s
Dim sFileName As String
Dim x As Integer
Dim blnErrFlag As Boolean
Dim strLogFileName As String
Dim objEmail As CDO.Message
Dim blnAddOnlyFlag As Boolean
Dim flag As String
Dim adoConn As ADODB.Connection
Dim sStartingURL As String
On Error Resume Next

sFileName = "C:\vbs\outlook.CSV" 'starting filename for CSV file location
sStartingURL = "file://./backofficestorage/test.com/public folders/DealerBooks/"

'On Error GoTo Escape
sFileName = InputBox("Where is the CSV file?", "Populate Array", sFileName)

'Open the Text file
Set fs = CreateObject("Scripting.FileSystemObject&quot
Set f = fs.GetFile(sFileName)
Set ts = f.OpenAsTextStream(1, -2) '(ForReading, TristateUseDefault)

'Initialize Log File
strLogFileName = "C:\VBS\ImportLog-" & Year(Now) & "-" & Month(Now) & "-" & Day(Now) & ".txt"
Set txtFile = fs.CreateTextFile(strLogFileName, True)
On Error GoTo ErrorHandler
'Write header for text file
txtFile.WriteLine ("Importing records from " & sFileName & " on " & Now)
blnErrFlag = False
x = 0 'track number of lines

'Repeat for each line
Do Until ts.AtEndOfStream = True
s = ts.ReadLine
'create array
arrsubstring = Split(s, ",&quot
strFolder = arrsubstring(36)

'Set Location of Contact File
sURL = sStartingURL & strFolder & "/"
'** Open a connection to the public folder using EXOLEDB provider
Set adoConn = New ADODB.Connection
With adoConn
.Provider = "exoledb.datasource"
.ConnectionString = sURL
.Mode = adModeReadWrite
.Open
End With

Call UpdateContact(sURL, arrsubstring(), adoConn)
Escape2:
Loop
ErrorHandler: 'and normal close
If Err.Number Then
txtFile.WriteLine "Error Occurred " & Err.Number & "-" & Err.Description & " at record DSM " & arrsubstring(36) & "-" & arrsubstring(0) & arrsubstring(2) & arrsubstring(3)
blnErrFlag = True
Err.Clear
Resume Escape2

End If
Escape:
'Close log file
ts.Close
txtFile.WriteLine ("***" & x & " records processed" & " on " & Now)
txtFile.Close 'Close Logfile
'Email Lyle
Set objEmail = CreateObject("CDO.Message&quot
objEmail.From = "administrator@test.com"
objEmail.To = "gbren@test.com"
If blnErrFlag = True Then
objEmail.Subject = "CSV to Contacts Failed"
objEmail.TextBody = "CSV to Contacts has run. There has been at least one error."
End If
If blnErrFlag = False Then
objEmail.Subject = "CSV to Contacts Successful"
objEmail.TextBody = "CSV to Contacts has run. There were no errors."
End If
objEmail.AddAttachment (strLogFileName)
objEmail.Send

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'The following code was downloaded from

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnmes2k/html/cwswp_0001.asp

'and modified by gbren.
'
'* Developed by Quadrus Development Inc. *'
'*

http://www.quadrus.com

*'
'* *'
'* Quadrus Development Inc. makes no representations or warranties respecting *'
'* this demo application and associated code including as to the accuracy, *'
'* completeness, reliability, or fitness for a particular use of the demo *'
'* application and associated code. *'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SUB UpdateContact
'
' Description: Update the corresponding Exchange contact record with
' the customer information from SQL Server.
' If the contact record does not exist, create it and
' initialize the service provider information.
'
' Parameters: strFolderURL - URL path to the Exchange public folder
' fldCust - fields of the customer record from SQL Server
' adoConn - ADO connection to the Exchange public folder
'
' Errors are logged to the event log but not propagated to the calling
' function. This is done so that the entire update procedure does not fail
' because of one customer
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub UpdateContact(strFolderURL As String, _
fldCust As Variant, _
adoConn As ADODB.Connection)

On Error GoTo ErrorHandler

Dim strContactURL As String
Dim cdoPerson As CDO.Person
Dim strCustomerID As String
Dim strFirstName As String
Dim strLastName As String
Dim strCompany As String
Dim strDSM As String


'** Retrieve customer ID and name information
strCustomerID = arrsubstring(39) 'Dealer #
strFirstName = arrsubstring(0) 'First Name
strLastName = arrsubstring(2) 'Last Name
strCompany = arrsubstring(3) 'Company
strDSM = arrsubstring(36) 'District Sales Mgr

'** Build the URL to the contact record in the Exchange public folder
'** We use Company, LastName, FirstName, and Customer ID as a unique readable filename
strFolderURL = "file://./backofficestorage/test.com/public folders/DealerBooks/" & strDSM & "/"
strContactURL = strFolderURL & strCompany & strLastName & strFirstName & strCustomerID & ".eml"

'** Turn off error checking while we try to open the contact using CDO
On Error Resume Next

Set cdoPerson = New CDO.Person
cdoPerson.DataSource.Open strContactURL, adoConn, adModeReadWrite, adFailIfNotExists

'** Check the error to see if a contact record does not yet exist
If Err.Number = ERR_CONTACT_NOT_FOUND Then
'** This is a new contact
'Update Form
Form1.lbl1.Caption = "Adding... " & arrsubstring(0) & arrsubstring(2) & arrsubstring(3)
txtFile.WriteLine ("Added... DSM " & arrsubstring(36) & "-" & arrsubstring(0) & arrsubstring(2) & arrsubstring(3))
Form1.Refresh

'** Reset the error handler
On Error GoTo ErrorHandler

'** Update the name fields and save the contact record
cdoPerson.FirstName = strFirstName
cdoPerson.LastName = strLastName
cdoPerson.Company = strCompany
cdoPerson.Title = strCustomerID
cdoPerson.DataSource.SaveTo strContactURL, adoConn

'** Open the contact record again so we can update the address info
cdoPerson.DataSource.Open strContactURL, adoConn, adModeReadWrite, adFailIfNotExists

ElseIf Err Then
'** A different error occurred; let the error handler take care of it
GoTo ErrorHandler

End If

'** Reset the error handler, which will still be in RESUME NEXT if no error occurred
On Error GoTo ErrorHandler

'** Update the person's contact information for new or existing records
cdoPerson.WorkCity = arrsubstring(7)
cdoPerson.WorkState = arrsubstring(8)
cdoPerson.WorkPostalCode = arrsubstring(9)
cdoPerson.WorkCountry = arrsubstring(10)
cdoPerson.HomeCity = arrsubstring(14)
cdoPerson.HomeState = arrsubstring(15)
cdoPerson.HomePostalCode = arrsubstring(16)
cdoPerson.HomeCountry = arrsubstring(17)
cdoPerson.WorkPhone = arrsubstring(25)
cdoPerson.WorkFax = arrsubstring(27)
cdoPerson.MobilePhone = arrsubstring(28)
cdoPerson.HomePhone = arrsubstring(30)
cdoPerson.HomeFax = arrsubstring(32)
cdoPerson.Email = arrsubstring(33)
cdoPerson.Email2 = arrsubstring(34)
cdoPerson.Email3 = arrsubstring(35)
cdoPerson.Title = arrsubstring(39) 'Dealer #
cdoPerson.HomeStreet = arrsubstring(11) & IIf(arrsubstring(12) <> &quot;&quot;, vbCrLf & arrsubstring(12), &quot;&quot & IIf(arrsubstring(12) <> &quot;&quot;, vbCrLf & arrsubstring(13), &quot;&quot
cdoPerson.WorkStreet = arrsubstring(4) & IIf(arrsubstring(5) <> &quot;&quot;, vbCrLf & arrsubstring(5), &quot;&quot & IIf(arrsubstring(6) <> &quot;&quot;, vbCrLf & arrsubstring(6), &quot;&quot
If cdoPerson.LastName = &quot;&quot; Then 'If there is no last name, use the business address as primary
cdoPerson.FileAsMapping = cdoMapToOrg
cdoPerson.MailingAddressID = cdoBusinessAddress
Else
cdoPerson.FileAsMapping = cdoMapToLastFirst
cdoPerson.MailingAddressID = cdoHomeAddress
End If
cdoPerson.Fields(&quot;urn:schemas:Contactsrganizationmainphone&quot = arrsubstring(26)
cdoPerson.Fields(&quot;urn:schemas:contacts:department&quot = arrsubstring(36) 'DSM #
cdoPerson.Fields(&quot;urn:schemas:contactsrofession&quot = arrsubstring(37) 'Region
cdoPerson.Fields(&quot;urn:schemas:contacts:nickname&quot = arrsubstring(38) 'Active/Inactive

'** Save the updates to the contact record
cdoPerson.Fields.Update
cdoPerson.DataSource.Save
'Update Form
Form1.lbl1.Caption = &quot;Changing... &quot; & arrsubstring(0) & arrsubstring(2) & arrsubstring(3)
txtFile.WriteLine (&quot;Changing... DSM &quot; & arrsubstring(36) & &quot;-&quot; & arrsubstring(0) & arrsubstring(2) & arrsubstring(3))
Form1.Refresh

'** Clean up
Set cdoPerson = Nothing
Exit Sub

ErrorHandler:
If Err.Number Then
txtFile.WriteLine &quot;Error Occurred &quot; & Err.Number & &quot;-&quot; & Err.Description & &quot; at record DSM &quot; & arrsubstring(36) & &quot;-&quot; & arrsubstring(0) & arrsubstring(2) & arrsubstring(3)
Err.Clear
End If
End Sub

 

[mattKnight]

gkbren

First, a couple of small points ( that are probably irrelevant to the problem at hand)

 Dim fs, f, ts, s

I, personally, dislike &quot;un-typed&quot; (ok variant then) variables, where a typed one will do

thus

Dim fs as filesystemobject
Dim f as file
dim ts as textstream
dim s as string

(whilst I can't check these are the correct types (not at development machine) I am they are *nearly*n right!)

second,

 '** Open a connection to the public folder using EXOLEDB provider
    Set adoConn = New ADODB.Connection
    With adoConn
        .Provider = "exoledb.datasource"
        .ConnectionString = sURL
        .Mode = adModeReadWrite
        .Open
    End With

Why not move this section of code out of the loop? It will increase code speed quite dramatically. You don't need to open the connection each time! (and at the end of the routine close the connection too)


I would suggest that you add more info to your log file, as a debugging aid
the loop for reading and processing the CSV will look like this

'Repeat for each line
Do Until ts.AtEndOfStream = True
        s = ts.ReadLine
        txtFile.WriteLine "Read Line " & s    'create array
        arrsubstring = Split(s, ",")
        txtFile.WriteLine " Split array into " & ubound(arrsubstring) & " Items"
        strFolder = arrsubstring(36)
        
    'Set Location of Contact File
        sURL = sStartingURL & strFolder & "/"
        txtFile.WriteLine " strURL =  " & sURL

    
        Call UpdateContact(sURL, arrsubstring(), adoConn)
        txtFile.WriteLine " Contact Updated"
Escape2:
Loop

Just as a final point, I can't see where the linecount variable x is incremented!

I hope this helps a bit!

Post some results back, and we can help more¬


Take Care

Matt
If at first you don't succeed, skydiving is not for you.

 

[gkbren]

Thank you for the advice. Your naming conventions were right and I have adjusted them (shame on Microsoft for posting them as they were!)

Regarding your second item, the string sURL may change for each record--this controls which subfolder the record is supposed to go into. I have about 70 subfolders and the file for import is not grouped by subfolder and not all subfolders are used each time. This will keep me from pulling it out of the loop. But fortunately, speed is fine--it processes over 300 records in less than 1 minute. (My original code took 9 minutes to process!)

Before I get to the log file, the x value is used in reference to a form with a progress bar--the line x=0 should have been erased from above. Missed that one.

Thanks for the reminder about using the log file. It is breaking at the line
arrsubstring = Split(s, &quot;,&quot

In my sample data, it breaks at record 327. Here's some relevant sections from the log file:

=======================================================
Importing records from C:\vbs\400records.CSV on 10/10/2003 2:11:35 PM
Read Line First Name,Middle Name,Last Name,Business Name,Business Address 1,Business Address 2,Business Address 3,Business City,Business State,Business Zip Code,Business Country,Home Address 1,Home Address 2,Home Address 3,Home City,Home State,Home Zip Code,Home Country,Other Address 1,Other Address 2,Other Address 3,Other City,Other State,Other Zip Code,Other Country,Business Phone,Business Phone 2,Business Fax,Cell Phone,Cell Phone 2,Home Phone,Home Phone 2,Home Fax,EMAIL Address,EMAIL Address 2,EMAIL Address 3,36,DSM Region,Active/InActive,DealerNo
Record number 1
Split array into 39 Items
strURL = file://./backofficestorage/test.com/public folders/DealerBooks/36/
Changing... DSM 36-First NameLast NameBusiness Name
Contact Updated
:
:
Read Line ,,,S Farms,Attn: E S,,,,,,US,,,,,,,,,,,,,,,,,507-555-1212,,,507-555-1212,,,,,,18,NE,ACTIVE,88130
Record number 326
Split array into 39 Items
strURL = file://./backofficestorage/test.com/public folders/DealerBooks/18/
Changing... DSM 18-S Farms
Contact Updated

Read Line Virgil,,Ast,,,,,,,,,,,,,,,US,,,,,,,,,,,417-555-1212,,417-555-1212,,,jdoe@xyz.com,,,19,SE,ACTIVE,92130
Record number 327
Split array into 39 Items
strURL = file://./backofficestorage/test.com/public folders/DealerBooks/19/
Changing... DSM 19-VirgilAst
Contact Updated

Read Line ,,,MWFInc,,Attn: LS,,,,,,,,,,,,,,,,,,,,417-555-1212,,417-555-1212,,,,,,jdoe@xyz.com,,,19,SE,ACTIVE,54700
Record number 328
Error Occurred 6-Overflow at record DSM 19-VirgilAst


Read Line D,,Ttt,,,,,,,,,,,,,,,US,,,,,,,,620-555-1212,,620-555-1212,620-555-1212,,620-555-1212,,,jdoe@xyz.com,,,19,SE,ACTIVE,85320
Record number 329
Error Occurred 6-Overflow at record DSM 19-VirgilAst
:
:
***400 records processed on 10/10/2003 2:06:49 PM

=======================================================

Thank you for taking the time to look at this! It's hard being a lone programmer and sometimes you really need someone to look at the code with you.

If you have any ideas on what's causing the problem, please let me know. This project is due MONDAY!

 

[gkbren]

Just a followup. I was trying to troubleshoot my problem and included a for-next loop to document all the values of the array after they were in the array. I had to include a line &quot;On Error Resume Next&quot; for this to work (this was included right after [arrsubstring = Split(s, &quot;,&quot].

The program processed all 1500 records without a problem!

So, my program is fixed for Monday, and it's not even 5 PM yet on Friday. I guess I can breathe easier.

I want to say Bravo and Thank you to anyone who is actually reading this. Those of us that are stuck in dark and dank programming dungeons occasionally need a ray of light and you have provided that for me.