...

View Full Version : need second pair of eyes



boogaboo
04-28-2004, 04:37 PM
Hello all,
If anyone has some spare minutes, I need a second pair of eyes. Basically it's a vbs script that connects to an act database and does a search and fill based upon criteria. When it reaches a certain amount of records, it starts to repeat the last entry, wether or not it needs updating. I believe it to be an array problem.
Please let me know if it is ok to post the code.

Thanks!

sage45
04-28-2004, 08:34 PM
Sure post your code...

-sage-

boogaboo
04-30-2004, 01:26 AM
Ok, i know that this is in vbs, but I just need some ideas on speeding it up. Everything is working fine now.

OPTION Explicit
' Contact Field Unique IDs
'************************************
'Declare constants that will be used*
'************************************
Public Const CF_UniqueID = 1
Public Const CF_CreateTimestamp = 2
Public Const CF_EditTimestamp = 3
Public Const CF_MergeTimestamp = 4
Public Const CF_PublicPrivate = 5
Public Const CF_RecordManager = 6
Public Const CF_Company = 25
Public Const CF_Name = 26
Public Const CF_Address1 = 27
Public Const CF_Address2 = 28
Public Const CF_Address3 = 29
Public Const CF_City = 30
Public Const CF_State = 31
Public Const CF_Zip = 32
Public Const CF_Country = 33
Public Const CF_IDStatus = 34
Public Const CF_Phone = 35
Public Const CF_Fax = 36
Public Const CF_HomePhone = 37
Public Const CF_MobilePhone = 38
Public Const CF_Pager = 39
Public Const CF_Salutation = 40
Public Const CF_LastMeet = 41
Public Const CF_LastReach = 42
Public Const CF_LastAttempt = 43
Public Const CF_LetterDate = 44
Public Const CF_Unused1 = 45
Public Const CF_Title = 46
Public Const CF_Assistant = 47
Public Const CF_LastResults = 48
Public Const CF_ReferredBy = 49
Public Const CF_User1 = 50
Public Const CF_User2 = 51
Public Const CF_User3 = 52
Public Const CF_User4 = 53
Public Const CF_User5 = 54
Public Const CF_User6 = 55
Public Const CF_User7 = 56
Public Const CF_User8 = 57
Public Const CF_User9 = 58
Public Const CF_User10 = 59
Public Const CF_User11 = 60
Public Const CF_User12 = 61
Public Const CF_User13 = 62
Public Const CF_User14 = 63
Public Const CF_User15 = 64
Public Const CF_AltAddress1 = 65
Public Const CF_AltAddress2 = 66
Public Const CF_AltCity = 67
Public Const CF_AltState = 68
Public Const CF_AltZip = 69
Public Const CF_AltCountry = 70
Public Const CF_AltPhone = 71
Public Const CF_Name2 = 72
Public Const CF_Title2 = 73
Public Const CF_Phone2 = 74
Public Const CF_Name3 = 75
Public Const CF_Title3 = 76
Public Const CF_Phone3 = 77
Public Const CF_FirstName = 78
Public Const CF_LastName = 79
Public Const CF_Ext = 80 ' the work phone extension
Public Const CF_FaxExt = 81 ' the fax extension
Public Const CF_AltPhoneExt = 82 ' alternate phone extension
Public Const CF_Phone2Ext = 83 ' contact 2 phone extension
Public Const CF_Phone3Ext = 84 ' contact 3 phone extension
Public Const CF_AsstTitle = 85 ' the assistants title
Public Const CF_AsstPhone = 86 ' the assistant phone
Public Const CF_AsstExt = 87 ' the assistant extension
Public Const CF_Department = 88 ' the contact's department
Public Const CF_Spouse = 89 ' the contact's spouse name
Public Const CF_Creator = 90 ' the creator of the record
Public Const CF_UsersCompany = 91 ' equivalent to the ACT! 2.0 Owner
field (the company of the user that owns the record)
Public Const CF_Alt1Reach = 92 ' alternate contact 1 last reach
(for ACT! 2.0 compatability)
Public Const CF_Alt2Reach = 93 ' alternate contact 2 last reach
(for ACT! 2.0 compatability)
Public Const CF_URL = 94 ' URL or web site address
Public Const CF_TickerSymbol = 95
Public Const CF_ContactType = 125
Public Const CVF_EmailAddress = 200 ' for display of e-mail address
Public Const CVF_Note = 201 ' for "import" of note
Public Const CVF_EmailLogon = 202 ' separate components for e-mail
logon
Public Const CVF_EmailCarrier = 203 ' separate component for e-mail
carrier


'***********************************
'Declare all our variables *
'***********************************
Dim objDatabase 'as object
Dim objContact 'as object
Dim WshShell 'as object
Dim objApp 'as object
Dim i 'as int
Dim startval 'as int
Dim endval 'as int
Dim contactid 'as int
Dim x 'as int
Dim personname 'as int
Dim c 'as int
Dim t 'as int
Dim counter 'as int
Dim m 'as int
Dim o 'as int
Dim n 'as int
Dim maxs 'as int
Dim maxt 'as int
Dim tempvar 'as int
Dim q 'as int
Dim maxtitle 'as int
Dim singletitle 'as string
Dim chooser 'as string
Dim persontitle 'as string
Dim insertname 'as string
Dim inserttitle 'as string
Dim tempvar1 'as string
Dim s 'as string
Dim midinitial 'as string
Dim person 'as string
Dim title 'as string
Dim titlearr 'as array
Dim prioritylevel(7) 'as array
Dim prioritylevel1(7) 'as array
Dim match 'as array
Dim match1 'as array
Dim maxarr 'as array
Dim temparr 'as array
Dim updater 'as array
Dim jollyfun 'as array
Dim firstlast 'as array
Dim maxarr1 'as array
Dim temparr1 'as array




'***************************************
'start the main code *
'***************************************
Set objDatabase = CreateObject("ACTOLE.DATABASE")
Set WshShell = WScript.CreateObject("WScript.Shell")
objDatabase.Open "C:\Act DB Copy\DataTrade Banks DB\DataTrade Banks.dbf" WScript.Echo "Beginning run at " & Now()

If objDatabase.IsMultiUser = True Then
objDatabase.ValidateUser "Clay Hamlet", ""
Else
'single user here
Login = True
End If
If objDatabase.IsOpen = True Then
startval = cInt(InputBox("Please enter the record number you
would like to start at.", "Enter record number"))
endval = cInt(InputBox("Please enter the last record number you
would like to end at.","Enter the last record number" ))
x = startval - 12
Do Until x >= endval - 11
objDatabase.CONTACT.Edit
objDatabase.CONTACT.MoveFirst
objDatabase.CONTACT.Jump x
person = objDatabase.CONTACT.Data(26)
title = objDatabase.CONTACT.Data(46)
If Len(person) > 1 AND Len(title) > 1 Then
WScript.Echo ""
wscript.echo objDatabase.CONTACT.Position & " "
& person & " " & title
WScript.Echo ""
WScript.Echo "Moving to next record. This
record " & objDatabase.CONTACT.Position & " is done."
WScript.Echo ""
objDatabase.CONTACT.MoveNext
Else'if Len(objDatabase.CONTACT.Data(26)) < 1
OR Len(objDatabase.CONTACT.Data(46)) < 1 Then
Call gothru
End If
x = x + 1
WScript.Sleep 0
Loop

Else
MsgBox("NOT CONNECTED TO DATABASE.")
End If
objDatabase.Close
Set objDatabase = Nothing
WScript.Quit


'**************************************
'start our sub routines *
'**************************************
Sub gothru
'On Error Resume Next
i = 1
WScript.Echo ""
WScript.Echo "Starting to edit record number: " & objDatabase.CONTACT.Position WScript.Echo ""
objDatabase.CONTACT.Edit
If objDatabase.CONTACT.IsLocked = True Then
For i = 1 To 204
c = CInt(objDatabase.CONTACT.FIELDS.FieldId(i&"C")) 'this is
the adl contact name
t = CInt(objDatabase.CONTACT.FIELDS.FieldId(i&"T")) 'this is
the adl title
personname = objDatabase.CONTACT.DATA(c)
persontitle = objDatabase.CONTACT.DATA(t)

'**************************************
'We start our priority level arrays *
'**************************************
If InStr(1, objDatabase.CONTACT.DATA(t), ", ") > 0 Then
titlearr = Split(persontitle, ", ")
For n = 0 To UBound(titlearr)
chooser = titlearr(n)
Select case chooser
Case "Ch Info Tech"
prioritylevel(0) = 7 & "," &
personname & "-" & persontitle
'MsgBox("multi " &personname)
'MsgBox(chooser)
Case "Info Tech"
prioritylevel(1) = 6 & "," &
personname & "-" & persontitle
'MsgBox("multi " &personname)
'MsgBox(chooser)
Case "DP"
prioritylevel(2) = 5 & "," &
personname & "-" & persontitle
'MsgBox("multi " &personname)
'MsgBox(chooser)
Case "Oper"
prioritylevel(3) = 4 & "," &
personname & "-" & persontitle
'MsgBox("multi " &personname)
'MsgBox(chooser)
Case "Cash"
prioritylevel(4) = 3 & "," &
personname & "-" & persontitle
'MsgBox("multi " &personname)
'MsgBox(chooser)
Case "CFO"
prioritylevel(5) = 2 & "," &
personname & "-" & persontitle
'MsgBox("multi " &personname)
'MsgBox(chooser)
Case "CEO"
prioritylevel(6) = 1 & "," &
personname & "-" & persontitle
'MsgBox("multi " &personname)
'MsgBox(chooser)
Case Else
End Select
Next
'MsgBox(prioritylevel(1))
'wscript.echo prioritylevel(1)
Else
titlearr = Split(persontitle,",")
For n = 0 To UBound(titlearr)
chooser = persontitle
Select case chooser
Case "Ch Info Tech"
prioritylevel1(0) = 7 & "," &
personname & "-" & persontitle
'MsgBox("single " &personname)
'MsgBox(chooser)
Case "Info Tech"
prioritylevel1(1) = 6 & "," &
personname & "-" & persontitle
'MsgBox("single " &personname)
'MsgBox(chooser)
Case "DP"
prioritylevel1(2) = 5 & "," &
personname & "-" & persontitle
'MsgBox("single " &personname)
'MsgBox(chooser)
Case "Oper"
prioritylevel1(3) = 4 & "," &
personname & "-" & persontitle
'MsgBox("single " &personname)
'MsgBox(chooser)
Case "Cash"
prioritylevel1(4) = 3 & "," &
personname & "-" & persontitle
'MsgBox("single " &personname)
'MsgBox(chooser)
Case "CFO"
prioritylevel1(5) = 2 & "," &
personname & "-" & persontitle
'MsgBox("single " &personname)
'MsgBox(chooser)
Case "CEO"
prioritylevel1(6) = 1 & "," &
personname & "-" & persontitle
'MsgBox("single " &personname)
'MsgBox(chooser)
Case Else
End Select
Next
'MsgBox(prioritylevel1(1))
'wscript.echo prioritylevel1(1)
End If
If objDatabase.Error = True Then
WScript.Echo "Database Error: " & objDatabase.LastError
End If
If Trim(personname = "") AND Trim(persontitle = "") Then
WScript.Echo "Exiting priority level code block."
Exit For
End If
Next

'***************************************************
'here's where we sort out our priority level arrays*
'***************************************************
maxs = 0
For m = 0 To UBound(prioritylevel)
If prioritylevel(m) <> "" Then
For q = 0 To UBound(prioritylevel)
maxarr = split(maxs,",")
temparr = split(prioritylevel(m), ",")
If IsNumeric(temparr(0)) Then
If temparr(0) > maxarr(0) Then
maxs = temparr(0) & ","
For n = 1 to UBound(temparr)
maxs = maxs & " " & temparr(n)
Next
End If
End If
Next
End If
Next
'wscript.echo UBound(maxarr)
'wscript.echo UBound(temparr)

'MsgBox("maxs " &maxs)
'WScript.Echo "maxs " & maxs
maxt = 0
For m = 0 To UBound(prioritylevel1)
If prioritylevel1(m) <> "" Then
For q = 0 To UBound(prioritylevel1)
maxarr1 = split(maxt,",")
temparr1 = split(prioritylevel1(m), ",")
If IsNumeric(temparr1(0)) Then
If temparr1(0) > maxarr1(0) Then
maxt = temparr1(0) & ","
For n = 1 to UBound(temparr1)
maxt = maxt & " " & temparr1(n)
Next
End If
End If
Next
End If
Next

'MsgBox("maxt " &maxt)
wscript.echo "maxs " & maxs
WScript.Echo "maxt " & maxt
If Len(maxs) = 1 AND Len(maxt) = 1 Then
WScript.Echo "There are no additional contacts that match the criteria."
objDatabase.CONTACT.MoveNext
Exit Sub
Else If maxs <> "" Or maxt <> "" Then
match = Split(maxs, ",")
match1 = Split(maxt, ",")
End If
End If


wscript.echo "match " & match(0)
wscript.echo "match1 " & match1(0)
If match(0) > match1(0) Then
jollyfun = match(1)
Call insertrecord
ElseIf match(0) < match1(0) Then
jollyfun = match1(1)
Call insertrecord
ElseIf match(0) = match1(0) Then
jollyfun = match(1)
Call insertrecord
ElseIf match(0) = 0 And match1(0) = 0 Or match(0) = "" And macth1(0) = "" Then
objDatabase.MoveNext
Exit Sub
End If

If objDatabase.Error = True Then
WScript.Echo "Database Error: " & objDatabase.LastError
End If
End If
End Sub

'******************************************
'process our priorities and update records*
'******************************************
Sub insertrecord
If match(0) <> "" Then 'multiple title person
updater = Split(jollyfun, "-")
tempvar1 = updater(0)
firstlast = Split(Trim(tempvar1), " ")

For each s in firstlast
If Len(s) = 1 Then
midinitial = s
End If
Next
If UBound(firstlast) = 2 Then 'test for a name
with a middle initial
If Len(firstlast(0)) = 1 AND Len
(firstlast(1)) > 1 Then 'test for existance of a first initial
objDatabase.CONTACT.Data 26,
updater(0)
objDatabase.CONTACT.Data 46,
Replace(updater(1), " ", ", ")
objDatabase.CONTACT.Data 78,
firstlast(1) & " " & firstlast(0)
objDatabase.CONTACT.Data 79,
firstlast(2)
WScript.Echo "Name inserted
into record (1 first initial): " & firstlast(1) & " " & firstlast(0) & " " &
firstlast(2)
objDatabase.CONTACT.Update
objDatabase.CONTACT.MoveNext

ElseIf Len(firstlast(0)) >=2
AND Len(firstlast(1)) >= 2 Then 'test for existance for a name like La Name Name

objDatabase.CONTACT.Data 26, updater(0)

objDatabase.CONTACT.Data 46, Replace(updater(1), " ", ", ")

objDatabase.CONTACT.Data 78, firstlast(0) & " " & firstlast(1)

objDatabase.CONTACT.Data 79, firstlast(2)
WScript.Echo "Name
inserted into record (1 weird name): " & firstlast(0) & " " & firstlast(1)
& " " & firstlast(2)

objDatabase.CONTACT.Update

objDatabase.CONTACT.MoveNext

ElseIf Len(midinitial)
= 1 Then

objDatabase.CONTACT.Data 26, updater(0)

objDatabase.CONTACT.Data 46, Replace(updater(1), " ", ", ")

objDatabase.CONTACT.Data 78, firstlast(0) & " " & midinitial

objDatabase.CONTACT.Data 79, firstlast(2)

WScript.Echo "Name inserted into record (1 middle inital): " & firstlast
(0) & " " & midinitial & " " & firstlast(2)

objDatabase.CONTACT.Update

objDatabase.CONTACT.MoveNext
End If
Else If UBound(firstlast) = 1
Then 'just first and last name
objDatabase.CONTACT.Data 26,
updater(0)
objDatabase.CONTACT.Data 46,
Replace(updater(1), " ", ", ")
objDatabase.CONTACT.Data 78,
firstlast(0)
objDatabase.CONTACT.Data 79,
firstlast(1)
WScript.Echo "Name inserted
into record (1 first and last name): " & firstlast(0) & " " & firstlast(1)
objDatabase.CONTACT.Update
objDatabase.CONTACT.MoveNext
End If
End If

Else If match1(0) <> "" Then 'single title person
updater = Split(jollyfun, "-")
tempvar1 = updater(0)
firstlast = Split(Trim(tempvar1), " ")

For each s in firstlast
If Len(s) = 1 Then
midinitial = s
End If
Next
If UBound(firstlast) = 2 Then 'test for a name
with a middle initial
If Len(firstlast(0)) = 1 AND Len
(firstlast(1)) > 1 Then 'test for existance of a first initial
objDatabase.CONTACT.Data 26,
updater(0)
objDatabase.CONTACT.Data 46,
updater(1)
objDatabase.CONTACT.Data 78,
firstlast(1) & " " & firstlast(0)
objDatabase.CONTACT.Data 79,
firstlast(2)
WScript.Echo "Name inserted
into record (2 first initial): " & firstlast(1) & " " & firstlast(0) & " " &
firstlast(2)
objDatabase.CONTACT.Update
objDatabase.CONTACT.MoveNext
ElseIf Len(firstlast(0)) >=2
AND Len(firstlast(1)) >= 2 Then 'test for existance for a name like La Name Name

objDatabase.CONTACT.Data 26, updater(0)

objDatabase.CONTACT.Data 46, updater(1)

objDatabase.CONTACT.Data 78, firstlast(0) & " " & firstlast(1)

objDatabase.CONTACT.Data 79, firstlast(2)
WScript.Echo "Name
inserted into record (2 weird name): " & firstlast(0) & " " & firstlast(1)
& " " & firstlast(2)

objDatabase.CONTACT.Update

objDatabase.CONTACT.MoveNext
ElseIf Len(midinitial)
= 1 Then

objDatabase.CONTACT.Data 26, updater(0)

objDatabase.CONTACT.Data 46, updater(1)

objDatabase.CONTACT.Data 78, firstlast(0) & " " & midinitial

objDatabase.CONTACT.Data 79, firstlast(2)

WScript.Echo "Name inserted into record (2 middle inital): " & firstlast
(0) & " " & midinitial & " " & firstlast(2)

objDatabase.CONTACT.Update

objDatabase.CONTACT.MoveNext
End If
Else If UBound(firstlast) = 1
Then 'just first and last name
objDatabase.CONTACT.Data 26,
updater(0)
objDatabase.CONTACT.Data 46,
updater(1)
objDatabase.CONTACT.Data 78,
firstlast(0)
objDatabase.CONTACT.Data 79,
firstlast(1)
WScript.Echo "Name inserted
into record (2 first and last name): " & firstlast(0) & " " & firstlast(1)
objDatabase.CONTACT.Update
objDatabase.CONTACT.MoveNext
End If
End If
End If
If objDatabase.Error = True Then
WScript.Echo "Database Error: " & objDatabase.LastError
End If
'If Err.Number <> 0 Then
'MsgBox("THE FOLLOWING ERROR HAS OCCURED:" & vbcrlf
& "Number: " & Err.Number & vbcrlf & "Description: " & Err.Description & vbcrlf
& "Source: " & Err.Source)' & vbcrlf & "Line No: " & strErrorLineNo)
'WScript.Echo "THE FOLLOWING ERROR HAS OCCURED:" & Chr
(13) & "Number: " & Err.Number & Chr(13) & "Description: " & Err.Description &
Chr(13) & "Source: " & Err.Source
'End If
Exit Sub
End If
'*************************************
'reinitialize our arrays *
'*************************************
Erase match
Erase match1
Erase prioritylevel
Erase prioritylevel1
Erase updater
'Erase temparr
'Erase maxarr
'ReDim firstlast(5)
ReDim titlearr(25)
'n = 0
'm = 0
'q = 0
'i = 0
'maxt = 0
'maxs = 0
End Sub



EZ Archive Ads Plugin for vBulletin Copyright 2006 Computer Help Forum