Additionally, the CSV export feature of Crystal spits out incomplete data, so the Excel export is the best export.
So, what we need is an importer that can read data with empty columns, with a header line way down the page a few lines.
This partially completed importer works by finding, then analyzing the header line for column names, and noting which column name goes with which column number. With the offsets of each column, then, loop over the table, mapping each column back to column names, and using that to create an SQL string to insert the data. We also pass in some hints about which fields to quote, and which to convert from dateserials to textual dates.
This code doesn’t yet have the necessary code to import the data into the table. The final version of the code will run within Access, and control an instance of Excel.
Public Sub test()
Dim offsets As Dictionary
Dim quotes As New Dictionary
Dim row As Dictionary
Dim dest As New Dictionary
quotes.Add "code", "quote"
quotes.Add "PaidThrough", "date"
quotes.Add "Mems", "number"
quotes.Add "UpdateTime", "quote"
n = Format(Now(), "yyyy/mm/dd")
import_goto_start ("Customer #")
Set offsets = import_get_heading_offsets
' move cursor down one cell
While (Application.Selection <> "")
Application.ActiveCell.Offset(1, 0).Select
Set row = import_get_row(offsets)
dest.RemoveAll
dest.Add "code", row("Customer #")
dest.Add "PaidThrough", row("through")
dest.Add "Mems", row("Members")
dest.Add "UpdateTime", n
Sql = import_build_sql("foo", dest, quotes)
Debug.Print Sql
Wend
End Sub
Public Sub import_goto_start(search As String)
' moves cursor to the first likely line of data, which is the first
' cell of the header row. Call this before anything else.
r = 1
While (r < 20)
c = 1
While (c < 5)
With Workbooks(1).Worksheets(1)
If (.Cells(r, c) = search) Then
.Cells(r, c).Select
Exit Sub
End If
End With
c = c + 1
Wend
r = r + 1
Wend
End Sub
Function import_get_heading_offsets() As Dictionary
' returns a dictionary mapping field names to column numbers
Dim res As New Dictionary
Dim r As Integer
Dim c As Integer
With Workbooks(1).Worksheets(1)
c = Application.ActiveCell.Column
r = Application.ActiveCell.row
For col = c To 100
Heading = .Cells(r, col).Value2
If Heading <> "" Then
res.Add col, Heading
End If
Next
End With
' return that dictionary
Set import_get_heading_offsets = res
End Function
Function import_get_row(offsets As Dictionary) As Dictionary
' returns a row of data as an associative array
Dim res As New Dictionary
With Workbooks(1).Worksheets(1)
r = Application.ActiveCell.row
' what is the way to scan the row based on the collection's contents???
For col = 1 To 10
If offsets.Exists(col) Then
res.Add offsets.Item(col), .Cells(r, col).Value2
'Debug.Print "Adding " & .Cells(r, col).Value2 & " : " & offsets.Item(col)
Else
'Debug.Print "Column " & col & " ignored. " & offsets.Item(col) & " : " & .Cells(r, col).Value2
End If
Next
End With
Set import_get_row = res
End Function
Function import_build_sql(table As String, data As Dictionary, quotes As Dictionary) As String
' takes an associative array as input and generates an "insert"
' for the table. the field names must match.
s = ""
For Each d In data
If s <> "" Then s = s & ", "
If (quotes(d) = "quote") Then
s = s & " " & d & "='" & data(d) & "'"
ElseIf (quotes(d) = "date") Then
s = s & " " & d & "='" & Format(data(d), "yyyy/mm/dd") & "'"
Else
s = s & " " & d & "=" & data(d)
End If
Next
s = "INSERT INTO " & table & s
import_build_sql = s
End Function
' PHP pseudocode
' offsets = import_get_heading_offsets()
' while( row = import_get_row(offsets) ) :
' new['field1'] = row['fieldx']
' ...
' sql = import_build_sql('table', new)
' cn.execute sql
' endwhile
The code’s a little bit dirty. VBA Dictionaries were hard to learn, because MS docs tend to have simple example code. There are a few places I wished to make more efficient.