This content is not currently approved and is visible here for review only.

Library code snippets

Database Manipulation with VB6

Main Code Block













Private Sub Command1_Click()
  

    Dim Cnt As Integer
    Dim noofassets As Integer
    Dim testcount As Integer
    testcount = 1
    'Open Database
    Call opendb
    filename = App.Path & "\Items.csv"
    Open filename For Output As #1
    Print #1, "AssetID, ConfigCode, ItemName, Category, Manufacturer, Model, Department, Room, SerialNumber, Building, Timestamp"
    'Find out how many records are in the database
    Set rstRecordSet = conConnection.Execute("Select count(*) from Item")
    Cnt = rstRecordSet.Fields(0)
    'On-screen Animation
    Animation1.Visible = True
    filename = App.Path & "\file2.avi"
    Animation1.Open filename
    Animation1.Play
    ProgressBar1.Visible = True
    ProgressBar1.Min = 0
    ProgressBar1.Max = Cnt
    incounter = 0
    Label2.Caption = "Status : Loading Asset Data"
    Form1.Refresh
    sqlstring = "select assertref, itemcategory, itemname, itemmodel, serialno, Manufacturer, parentcode from item order by assertref"
    Set rstsubrecordset = conConnection.Execute(sqlstring)
    While Not rstsubrecordset.EOF
 If rstsubrecordset!assertref <> "" Then
            checkfields2 (6)
            If isanerror(1) = "0" Then Call removep
            If isanerror(2) = "0" Then newrec.Category = rstsubrecordset!itemCategory
            If isanerror(3) = "0" Then newrec.ItemName = rstsubrecordset!ItemName
            If isanerror(4) = "0" Then newrec.Model = rstsubrecordset!itemmodel
            If isanerror(5) = "0" Then newrec.SerialNumber = rstsubrecordset!SerialNo
            If isanerror(6) = "0" Then newrec.Manufacturer = rstsubrecordset!Manufacturer
            If isanerror(7) = "0" Then
                newrec.ConfigCode = rstsubrecordset!parentcode
            Else
                newrec.ConfigCode = ""
            End If
            tempurn = "P"
            tempurn = tempurn & newrec.AssetNo
            sqlstring = "select configid, locationunique, location2, location3, date2 from configuration where configcode = '" & newrec.ConfigCode & "'"
            Set rstRecordSet = conConnection.Execute(sqlstring)
            If ((rstRecordSet.EOF <> True) And (rstRecordSet.BOF <> True)) Then
                checkfields (4)
           
                If isanerror(1) = "0" Then
                    newrec.ConfigID = rstRecordSet!ConfigID
                Else
                    newrec.ConfigID = "0"
                End If
                If isanerror(2) = "0" Then
                sqlstring = "select location1 from location where locationunique = '" & rstRecordSet!locationunique & "'"
                Set rstsubsubrecordset = conConnection.Execute(sqlstring)
                If Not IsNull(rstsubsubrecordset!location1) Then
                If rstsubsubrecordset.EOF <> True Then newrec.Location = rstsubsubrecordset!location1
                End If
                End If
                If isanerror(3) = "0" Then newrec.Department = rstRecordSet!location2
                If isanerror(4) = "0" Then newrec.Room = rstRecordSet!location3
                If isanerror(5) = "0" Then newrec.timestamp = rstRecordSet!date2
            End If
           ' If rstsubrecordset.EOF <> True Then
            rstsubrecordset.MoveNext
            If rstsubrecordset.EOF <> True Then
                If newrec.AssetNo = rstsubrecordset!assertref Then
           
                    If Not IsNull(rstsubrecordset!parentcode) Then
                        newrec.ConfigCode = rstsubrecordset!parentcode
                    Else
                        newrec.ConfigCode = ""
                    End If
                    sqlstring = "select configid, locationunique, location2, location3, date2 from configuration where configcode = '" & newrec.ConfigCode & "'"
                    Set rstRecordSet = conConnection.Execute(sqlstring)
                    If ((rstRecordSet.EOF <> True) And (rstRecordSet.BOF <> True)) Then
                       
                        If ((newrec.timestamp >= rstRecordSet!date2) Or (newrec.timestamp = "00:00:00")) Then
                            Call doprint
                        Else
                            If Not IsNull(rstRecordSet!locationunique) Then
                            sqlstring = "select location1 from location where locationunique = '" & rstRecordSet!locationunique & "'"
                            Set rstsubsubrecordset = conConnection.Execute(sqlstring)
                            If Not IsNull(rstsubsubrecordset!location1) Then
                            If rstsubsubrecordset.EOF <> True Then newrec.Location = rstsubsubrecordset!location1
                            End If
                            End If
               
                            newline = newline & rstsubrecordset!assertref & ","
                            newline = newline & rstRecordSet!ConfigID & ","
                            newline = newline & rstsubrecordset!ItemName & ","
                            newline = newline & rstsubrecordset!itemCategory & ","
                            newline = newline & rstsubrecordset!Manufacturer & ","
                            newline = newline & rstsubrecordset!itemmodel & ","
                            newline = newline & rstRecordSet!location2 & ","
                            newline = newline & rstRecordSet!location3 & ","
                            newline = newline & rstsubrecordset!SerialNo & ","
                            newline = newline & newrec.Location & ","
                            newline = newline & rstRecordSet!date2
                            Print #1, newline
                            newline = ""
                            rstsubrecordset.MoveNext
                        End If
                    End If
                Else
                    Call doprint
                End If
            End If
            newrec.ItemName = ""
            newrec.Category = ""
            newrec.Manufacturer = ""
            newrec.Model = ""
            newrec.SerialNumber = ""
            newrec.Department = ""
            newrec.Room = ""
            newrec.ConfigID = ""
            newrec.Building = ""
            newrec.AssetNo = ""
            tempurn = ""
            newrec.timestamp = "01/01/1990"
            testcount = testcount + 1
            incounter = incounter + 1
            ProgressBar1.Value = incounter
            newrec.ConfigID = ""
         Else:
            rstsubrecordset.MoveNext
        End If
    Wend
    'Application End
    Animation1.Stop
    ProgressBar1.Visible = False
    Animation1.Visible = False
    Close #1
    Close #2
    Label2.Caption = "Status : Done"
    conConnection.Close
    Call Populate
    Unload Me
End Sub
   
Public Sub doprint()
newline = newline & newrec.AssetNo & ","
newline = newline & newrec.ConfigID & ","
newline = newline & newrec.ItemName & ","
newline = newline & newrec.Category & ","
newline = newline & newrec.Manufacturer & ","
newline = newline & newrec.Model & ","
newline = newline & newrec.Department & ","
newline = newline & newrec.Room & ","
newline = newline & newrec.SerialNumber & ","
newline = newline & newrec.Location & ","
newline = newline & newrec.timestamp
Print #1, newline
newline = ""
End Sub

Comments

  1. 01 Jan 1999 at 00:00

    This thread is for discussions of Database Manipulation with VB6.

Leave a comment

Sign in or Join us (it's free).

AddThis