Library code snippets
Database Manipulation with VB6
- Overview
- Declarations & Create DB
- Get Legacy Data
- Main Code Block
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
This thread is for discussions of Database Manipulation with VB6.