This is a VB6 procedure (in an ActiveX dll) that handles this.
Obviously there are a lot of secondary routines that you don't have,
but I think you will
get the general idea of what is going on here.
Public Sub vArray2SQLiteTable(strDB As String, _
vArray As Variant, _
strTable As String, _
Optional strFields As String, _
Optional strIndexFields As String, _
Optional lIntegerPrimaryKeyColumn As Long = -1, _
Optional bISO8601Dates As Boolean = True, _
Optional strDataTypes As String, _
Optional bTempTable As Boolean)
Dim i As Long
Dim r As Long
Dim c As Long
Dim n As Long
Dim strSQL As String
Dim strCreateTable As String
Dim lArrayDims As Long
Dim LB1 As Long
Dim UB1 As Long
Dim LB2 As Long
Dim UB2 As Long
Dim btLBAdd As Byte
Dim lFields As Long
Dim bHasText As Boolean
Dim bHasNumber As Boolean
Dim bHasNonIntegerNumber As Boolean
Dim bHasDate As Boolean
Dim bSkipFirstRow As Boolean
Dim btSkipFirstRow As Byte
Dim arrDataTypes
Dim arrDataTypes2() As Byte
Dim arrDates() As Boolean
Dim cmddhSQLite As cCommand
Dim vTemp
10 On Error GoTo ERROROUT
20 LB1 = LBound(vArray)
30 UB1 = UBound(vArray)
'presume if fields are supplied then array doesn't have fields
in first row
'--------------------------------------------------------------------------
80 bSkipFirstRow = Len(strFields) = 0
90 If bSkipFirstRow Then
'as we skip the first row with fields
'------------------------------------
100 btSkipFirstRow = 1
110 End If
120 lArrayDims = GetArrayDims(vArray)
'get the table fields
'--------------------
160 If lArrayDims = 1 Then
170 If LCase(strFields) = "auto fields" Then
180 strFields = "Field1"
190 End If
200 If Len(strFields) = 0 Then
210 strFields = MakeValidSQLiteFieldName(vArray(LB1))
220 End If
230 lFields = 1
240 Else
250 LB2 = LBound(vArray, 2)
260 UB2 = UBound(vArray, 2)
270 If LCase(strFields) = "auto fields" Then
280 For i = LB2 To UB2
290 If i = LB2 Then
300 strFields = "Field1"
310 Else
320 strFields = strFields & ",Field" & i + (1 - LB2)
330 End If
340 Next i
350 End If
390 btLBAdd = 1 - LB2
430 lFields = (UB2 - LB2) + 1
470 If Len(strFields) = 0 Then
480 For c = LB2 To UB2
490 If c = LB2 Then
500 strFields = MakeValidSQLiteFieldName(vArray(LB1, LB2))
510 Else
520 strFields = strFields & "," &
MakeValidSQLiteFieldName(vArray(LB1, c))
530 End If
570 Next c
580 End If
590 End If
'to avoid duplicate fields
'-------------------------
630 strFields = AddNumbersToDuplicateFields(strFields)
'get the data types
'------------------
670 If Len(strDataTypes) = 0 Then
680 strDataTypes = GetDataTypesFromVArray(vArray, bSkipFirstRow)
690 End If
'make the array of datatypes shown as Bytes
'------------------------------------------
730 arrDataTypes = Split(strDataTypes, ",")
'to make ISO8601 dates if the array column is dates or blanks only
'-----------------------------------------------------------------
740 If bISO8601Dates Then
750 If lArrayDims = 1 Then
760 If arrDataTypes(0) = "DATE" Then
770 For r = LB1 To UB1
780 If Not IsEmpty(vArray(r)) Then
790 vArray(r) = Format(vArray(r), "yyyy-mm-dd")
800 End If
810 Next r
820 End If
830 Else
840 For c = 0 To UBound(arrDataTypes)
850 If arrDataTypes(c) = "DATE" Then
860 For r = LB1 To UB1
870 If Not IsEmpty(vArray(r, c + LB2)) Then
880 vArray(r, c + LB2) = Format(vArray(r, c + LB2),
"yyyy-mm-dd")
890 End If
900 Next r
910 End If
920 Next c
930 End If
1070 End If
'to keep track of date columns
'-----------------------------
1080 ReDim arrDates(1 To UBound(arrDataTypes) + 1) As Boolean
'treat the date columns as text
'------------------------------
1090 If lArrayDims = 1 Then
1100 If arrDataTypes(0) = "DATE" Then
1110 arrDataTypes(0) = "TEXT"
1120 End If
1130 Else
1140 For c = 0 To UBound(arrDataTypes)
1150 If arrDataTypes(c) = "DATE" Then
1160 arrDataTypes(c) = "TEXT"
1170 arrDates(c + 1) = True
1180 End If
1190 Next c
1200 End If
1210 strDataTypes = Replace(strDataTypes, "DATE", "TEXT", , ,
vbBinaryCompare)
'drop table if it exists
'-----------------------
1220 DropSQLiteTable strDB, strTable, , True
'create the CREATE TABLE SQL
'---------------------------
1230 On Error GoTo 0
1240 strCreateTable = GetSQLiteCreateTableString(strTable, _
strSQL, _
lIntegerPrimaryKeyColumn, _
strFields, _
strDataTypes, _
False, _
bTempTable, _
False, _
strDB)
1250 On Error GoTo ERROROUT
'create the receiving SQLite table
'---------------------------------
1290 AlterDB strCreateTable, strDB, False
1300 ReDim arrDataTypes2(1 To UBound(arrDataTypes) + 1) As Byte
'note that if arrDataTypes(c) is empty then arrDataTypes2 will
be 0, so setting TEXT
'-----------------------------------------------------------------------------------
1310 For c = 0 To UBound(arrDataTypes)
1320 Select Case arrDataTypes(c)
Case "TEXT"
1330 arrDataTypes2(c + 1) = 0
1340 Case "INTEGER"
1350 arrDataTypes2(c + 1) = 1
1360 Case "REAL"
1370 arrDataTypes2(c + 1) = 2
1380 Case "BLOB"
1390 arrDataTypes2(c + 1) = 3
1400 Case Else
1410 arrDataTypes2(c + 1) = 0
1420 End Select
1430 Next c
1440 If m_bInsertOrIgnore Then
1450 Set cmddhSQLite = _
CreateSQLiteCommand(strDB, "INSERT OR IGNORE INTO " & strTable & _
" VALUES(" &
MakeParameterString(lFields) & ")")
1460 Else
1470 If m_bInsertOrReplace Then
1480 Set cmddhSQLite = _
CreateSQLiteCommand(strDB, "INSERT OR REPLACE INTO " & strTable & _
" VALUES(" &
MakeParameterString(lFields) & ")")
1490 Else
1500 Set cmddhSQLite = _
CreateSQLiteCommand(strDB, "INSERT INTO " & strTable & _
" VALUES(" &
MakeParameterString(lFields) & ")")
1510 End If
1520 End If
1600 BeginTransaction strDB
'write the data to the SQLite table
'----------------------------------
1610 With cmddhSQLite
1620 If lArrayDims = 1 Then
1630 For r = LB1 + btSkipFirstRow To UB1
1640 If Not IsEmpty(vArray(r)) Then
1650 If arrDataTypes2(1) = 0 Then
1660 .SetText 1, CStr(vArray(r))
1670 Else
1680 If arrDataTypes2(1) = 1 Then
1690 .SetInt32 1, CLng(vArray(r))
1700 Else
1710 If arrDataTypes2(1) = 2 Then
1720 .SetDouble 1, CDbl(vArray(r))
1730 Else
1740 .SetText 1, CStr(vArray(r))
1750 End If
1760 End If
1770 End If
1780 Else 'If Not IsEmpty(vArray(r))
1790 If arrDates(1) Then
1800 .SetText 1, Chr(32) 'this is to prevent date
formatting in the Excel sheet
1810 Else
1820 .SetNull 1
1830 End If
1840 End If
1850 .Execute
1900 Next r
1910 Else 'If lArrayDims = 1
1920 For r = LB1 + btSkipFirstRow To UB1
1930 For c = LB2 To UB2
1940 If Not IsEmpty(vArray(r, c)) Then
1950 If arrDataTypes2(c + btLBAdd) = 0 Then
1960 .SetText c + btLBAdd, CStr(vArray(r, c))
1970 Else
1980 If arrDataTypes2(c + btLBAdd) = 1 Then
1990 .SetInt32 c + btLBAdd, CLng(vArray(r, c))
2000 Else
2010 If arrDataTypes2(c + btLBAdd) = 2 Then
2020 .SetDouble c + btLBAdd, CDbl(vArray(r, c))
2030 Else
2040 .SetText c + btLBAdd, CStr(vArray(r, c))
2050 End If
2060 End If
2070 End If
2080 Else 'If Not IsEmpty(vArray(r))
2090 If arrDates(c + btLBAdd) Then
2100 .SetText c + btLBAdd, Chr(32) 'this is to prevent
date formatting in the Excel sheet
2110 Else
2120 .SetNull c + btLBAdd
2130 End If
2140 End If
2150 Next c
2160 .Execute
2210 Next r
2220 End If 'If lArrayDims = 1
2230 End With
2280 If Len(strIndexFields) > 0 Then
2290 CreateSQLiteIndexes strDB, "SELECT " & strFields & " FROM "
& strTable, _
strTable, strIndexFields,
lIntegerPrimaryKeyColumn, _
True, True
2300 End If
2310 CommitTransaction strDB
2330 Exit Sub
ERROROUT:
End Sub
RBS
On Tue, May 18, 2010 at 3:29 PM, Gilles Ganault <[email protected]> wrote:
> On Tue, 18 May 2010 13:18:49 +0100, Bart Smissaert
> <[email protected]> wrote:
>>Quite simple that. Basically: range > variant array > loop through
>>array and write to SQLite.
>>Let me know and I will post some example code.
>
> If you have some basic code to go through Excel or OO sheets to gather
> data and somehow stick them into SQLite, that'd be useful to study.
>
> Thank you.
>
> _______________________________________________
> sqlite-users mailing list
> [email protected]
> http://sqlite.org:8080/cgi-bin/mailman/listinfo/sqlite-users
>
_______________________________________________
sqlite-users mailing list
[email protected]
http://sqlite.org:8080/cgi-bin/mailman/listinfo/sqlite-users
