Hello and welcome to our community! Is this your first visit?
Register
Enjoy an ad free experience by logging in. Not a member yet? Register.
Results 1 to 3 of 3
  1. #1
    New to the CF scene
    Join Date
    Apr 2004
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Question need second pair of eyes

    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!

  • #2
    Super Moderator sage45's Avatar
    Join Date
    May 2002
    Posts
    1,064
    Thanks
    0
    Thanked 15 Times in 15 Posts
    Sure post your code...

    -sage-
    HTML & CSS Forum Moderator

    "If you don't know what you think you know, then what do you know."
    R.I.P. Derrick Thomas #58
    1/1/1967 - 2/8/2000

  • #3
    New to the CF scene
    Join Date
    Apr 2004
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Smile

    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


  •  

    Posting Permissions

    • You may not post new threads
    • You may not post replies
    • You may not post attachments
    • You may not edit your posts
    •