Declarations & Create DB

'***** User Declarations *****'

Option Explicit

'User Defined Variables

'Database Connection variables
Dim conConnection As New ADODB.Connection
Dim rstRecordSet As New ADODB.Recordset
Dim rstrecset As New ADODB.Recordset
Dim rstsubrecordset As New ADODB.Recordset
Dim rstsubsubrecordset As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
Dim conaccess As New ADODB.Connection

'Counters
Dim incounter As Integer
Dim isanerror(100) As Integer
Dim a As Integer
Dim b As Integer
Dim uniqueno As Long
Dim filename As String

'SQL Data
Dim sqlstring As String
Dim tempurn As String

'CSV Variables
Dim newline As String

'Record Object
Dim newrec As assetrecord

'***** Start Up *****'

Private Sub Form_Load()

    On Error GoTo loaderror

    Open "C:\PDAProject\ErrorLog.txt" For Output As #3
    uniqueno = 0
loaderror:
If Err.Number <> 0 Then Call writeerrorlog("formload ", "Unknown ",_
	Err.Description, "")
End Sub

Create DB

Private Sub Populate()
Const TABLE_NAME As String = "Items.csv"
Dim ini_file As String
Dim db_file As String

Dim DB As DAO.Database
Dim query As String
Dim db_path As String
db_path = App.Path
    If Right$(db_path, 1) <> "\" Then db_path = db_path & "\"
    txtIniFile.Text = db_path & "Items.ini"
    txtDatabase.Text = db_path & "Copy of ItemsDB.mdb"
 
   
    'Local Variables
    ini_file = txtIniFile.Text
    db_file = txtDatabase.Text

    ' Tell the DB engine where to find table definitions.
    DBEngine.IniPath = ini_file
    Set DB = OpenDatabase(db_file, False, False)
    query = "DROP TABLE Items"
    DB.Execute query
 
    ' Open the database.
    Set DB = OpenDatabase(App.Path, False, False, _
    "Text;Database=" & App.Path & ";table=" & TABLE_NAME)
     query = "SELECT * INTO Items IN '" & _
        db_file & "' FROM " & TABLE_NAME
    DB.Execute query
    DB.Close
    Set DB = Nothing


    With conaccess
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source = C:\Documents and Settings\rbickel\Desktop\Copy of ItemsDB.mdb"
    .CursorLocation = adUseClient
    .Open
    End With
   
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim prp As DAO.Property
    Const conPropName = "AllowZeroLength"
    Const conPropValue = False
    Dim k As Integer
    k = 1
    Set DB = OpenDatabase(App.Path & "\Copy of ItemsDB", False, False)
 
 Set tdf = DB.TableDefs(0)
      If (tdf.Attributes And dbSystemObject) = 0 Then
            Debug.Print tdf.Name
            For Each fld In tdf.Fields
                If ((fld.Name <> "Timestamp") And (fld.Name <> "AssetID")) Then
                    If ((fld.Name <> "Room") And (fld.Name <> "Building")) Then
                    If fld.Properties(conPropName) = False Then
                        Debug.Print tdf.Name & "." & fld.Name
                        fld.Properties(conPropName) = True
                    End If
                    End If
                Else:
                    If fld.Name = "Timestamp" Then
                        Set prp = fld.CreateProperty("Format", dbText)
                        prp.Value = "dd-mmm-yyyy"
                        fld.Properties.Append prp
                    End If
                    If fld.Name = "Room" Then
                        Set prp = fld.CreateProperty("Format", dbText)
                         fld.Properties.Append prp
                        If fld.Properties(conPropName) = False Then
                        Debug.Print tdf.Name & "." & fld.Name
                        fld.Properties(conPropName) = True
                    End If
                  
                    End If
                    If fld.Name = "Building" Then
                        Set prp = fld.CreateProperty("Format", dbText)
                         fld.Properties.Append prp
                        If fld.Properties(conPropName) = False Then
                        Debug.Print tdf.Name & "." & fld.Name
                        fld.Properties(conPropName) = True
                    End If
                    End If
                End If
            Next
        End If
  '  Next
       
    Set prp = Nothing
    Set fld = Nothing
    Set tdf = Nothing
    Set DB = Nothing
 
 Close #1
End Sub