The Voice of Reason

Recently, I covered the case of converting CSV data into database table format.

Ex: A | B | C
ID | Business Name | Codes
72566477 | McDonald’s | Chicken_Sandwich,Fries,Diet_Coke,etc.

The below VBA code for MS Access provides for a way to reverse this process. That is, to convert the database table format:

Ex: A | B | C
ID | Business Name | Codes
72566477 | McDonald’s | Chicken_Sandwich
72566477 | McDonald’s | Fries
72566477 | McDonald’s | Diet_Coke

back to CSV like in the above example highlighted in green from the previous article (on a side note, please notice that the above table is not properly normalized and should be so for correct database structure). A better database design would take the following structure:

The function is currently setup without arguments but it can be easily modified for that. In it’s current setup, it’s easy to understand how to use the function and adjust it for your dataset but it would be limited to one-time use, i.e. it will need to be modified for arguments to be used in a looping algorithm.

Download: MakeCSV

Public Sub MakeCSV()
On Error GoTo ErrHandler

Dim con As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim rst1 As New ADODB.Recordset
Dim cat As New ADOX.Catalog
Dim fld As ADODB.Field
Dim tbl As ADOX.Table
Set con = Application.CurrentProject.Connection
Set cat.ActiveConnection = con
Dim strSQL As String, CSVKey() As String, CSVValueList As String
Dim CSVField() As String, CSVSource As String, MasterSource As String, NewTable As String
Dim NumberOfFields As Long, x As Long, y As Long, NumberGroupFields As Long
Dim LongData As Boolean, OnlyUnique As Boolean

'Set the name for the table you want to create
NewTable = "NEW_TABLE_NAME"
'Are you dealing with long data (>255 characters) or short data?
LongData = False
'Set the name of the table or query to reference
MasterSource = "EXISTING_QUERY_OR_TABLE_NAME"
'Set the number of grouping fields
NumberGroupFields = 3
'Allocate the array - //////// DO NOT ALTER THIS LINE \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
ReDim CSVKey(NumberGroupFields, 1)
'Set the Name of the key field you want to reference the CSV
CSVKey(1, 0) = "GROUP_FIELD_NAME_1"
CSVKey(2, 0) = "GROUP_FIELD_NAME_2"
CSVKey(3, 0) = "GROUP_FIELD_NAME_3"
'Set the number of fields you want to turn into a CSV
NumberOfFields = 2
'Allocate the array - //////// DO NOT ALTER THIS LINE \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
ReDim CSVField(NumberOfFields)
'Set the name of the field or fields you want to turn into CSV
CSVField(1) = "CSV_FIELD_NAME_1"
CSVField(2) = "CSV_FIELD_NAME_2"
'CSVField(3) = "CSV_FIELD_NAME_3"
'Grab Only Unique Values for the CSV?
OnlyUnique = True

'/////////////////////// DO NOT ALTER THE LINES BELOW \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'Check to see if the table exists - if it does, drop it
For Each tbl In cat.Tables
 If tbl.Name = NewTable Then
 cat.Tables.Delete NewTable
 End If
Next tbl
'Determine the data types for the CSVKey values
strSQL = "SELECT TOP 1"
For y = 1 To NumberGroupFields
 strSQL = strSQL & " [" & CSVKey(y, 0) & "],"
Next y
strSQL = Left(strSQL, Len(strSQL) - 1)
strSQL = strSQL & " FROM [" & MasterSource & "]"
With rst
 .Open strSQL, con, adOpenStatic, adLockReadOnly
 y = 1
 For Each fld In rst.Fields
 If fld.Type = 7 Then
 CSVKey(y, 1) = "Date"
 ElseIf fld.Type = 202 Then
 CSVKey(y, 1) = "Text"
 ElseIf fld.Type = adBigInt Then
 CSVKey(y, 1) = "Numeric"
 End If
 y = y + 1
 Next fld
 .Close
End With

'Create a table to hold the CSV values
strSQL = "CREATE TABLE [" & NewTable & "]"
strSQL = strSQL & " ([" & CSVKey(1, 0) & "] TEXT(255),"
If NumberGroupFields >= 2 Then
 For y = 2 To NumberGroupFields
 strSQL = strSQL & " [" & CSVKey(y, 0) & "] TEXT(255),"
 Next y
End If
For x = 1 To NumberOfFields
 If LongData = True Then
 strSQL = strSQL & " [" & CSVField(x) & "] MEMO,"
 Else
 strSQL = strSQL & " [" & CSVField(x) & "] TEXT(255),"
 End If
Next x
strSQL = Left(strSQL, Len(strSQL) - 1)
strSQL = strSQL & ")"
'Create the table
con.Execute strSQL

'Get the unique source items
For x = 1 To NumberOfFields
 'Get the distinct CSVKeys
 strSQL = "SELECT DISTINCT"
 For y = 1 To NumberGroupFields
 strSQL = strSQL & " [" & CSVKey(y, 0) & "],"
 Next y
 strSQL = Left(strSQL, Len(strSQL) - 1)
 strSQL = strSQL & " FROM [" & MasterSource & "]"
 With rst
 .Open strSQL, con, adOpenStatic, adLockReadOnly
 .MoveFirst
 While Not .EOF
 'Retrieve the values for the CSV list
 If OnlyUnique = False Then
 strSQL = "SELECT [" & CSVField(x) & "] FROM [" & MasterSource & "]"
 Else
 strSQL = "SELECT DISTINCT [" & CSVField(x) & "] FROM [" & MasterSource & "]"
 End If
 For y = 1 To NumberGroupFields
 If y = 1 Then
 If CSVKey(1, 1) = "Text" Then
 strSQL = strSQL & " WHERE ((([" & CSVKey(1, 0) & "]) = " & Chr(34) & rst.Fields(CSVKey(1, 0)) & Chr(34) & ")"
 ElseIf CSVKey(1, 1) = "Numeric" Then
 strSQL = strSQL & " WHERE ((([" & CSVKey(1, 0) & "]) = " & rst.Fields(CSVKey(1, 0)) & ")"
 ElseIf CSVKey(1, 1) = "Date" Then
 strSQL = strSQL & " WHERE ((([" & CSVKey(1, 0) & "]) = #" & rst.Fields(CSVKey(1, 0)) & "#)"
 End If
 Else
 If CSVKey(y, 1) = "Text" Then
 strSQL = strSQL & " AND (([" & CSVKey(y, 0) & "]) = " & Chr(34) & rst.Fields(CSVKey(y, 0)) & Chr(34) & ")"
 ElseIf CSVKey(y, 1) = "Numeric" Then
 strSQL = strSQL & " AND (([" & CSVKey(y, 0) & "]) = " & rst.Fields(CSVKey(y, 0)) & ")"
 ElseIf CSVKey(y, 1) = "Date" Then
 strSQL = strSQL & " AND (([" & CSVKey(y, 0) & "]) = #" & rst.Fields(CSVKey(y, 0)) & "#)"
 End If
 End If
 Next y
 strSQL = strSQL & ")"
 With rst1
 .Open strSQL, con, adOpenStatic, adLockReadOnly
 .MoveFirst
 'Create the CSV list
 While Not .EOF
 CSVValueList = CSVValueList & .Fields(CSVField(x)) & ", "
 .MoveNext
 Wend
 CSVValueList = Left(CSVValueList, Len(CSVValueList) - 2)
 .Close
 End With
 'Now insert the CSV values
 strSQL = "SELECT [" & CSVField(x) & "],"
 For y = 1 To NumberGroupFields
 strSQL = strSQL & " [" & CSVKey(y, 0) & "],"
 Next y
 strSQL = Left(strSQL, Len(strSQL) - 1)
 strSQL = strSQL & " FROM [" & NewTable & "]"
 strSQL = strSQL & " WHERE ((([" & CSVKey(1, 0) & "]) = " & Chr(34) & rst.Fields(CSVKey(1, 0)) & Chr(34) & ")"
 If NumberGroupFields >= 2 Then
 For y = 2 To NumberGroupFields
 strSQL = strSQL & " AND (([" & CSVKey(y, 0) & "]) = " & Chr(34) & rst.Fields(CSVKey(y, 0)) & Chr(34) & ")"
 Next y
 strSQL = strSQL & ")"
 Else
 strSQL = strSQL & ")"
 End If
 With rst1
 .Open strSQL, con, adOpenDynamic, adLockOptimistic
 If .BOF = True And .EOF = True Then
 'Add a new record
 .AddNew CSVKey(1, 0), rst.Fields(CSVKey(1, 0))
 For y = 2 To NumberGroupFields
 .Update CSVKey(y, 0), rst.Fields(CSVKey(y, 0))
 Next y
 .Update CSVField(x), CSVValueList
 Else
 'Record Exists
 .Update CSVField(x), CSVValueList
 End If
 .Close
 End With
 'Clear the CSV value
 CSVValueList = ""
 'Move to the next CSVKey
 .MoveNext
 Wend
 .Close
 End With
Next x

'Close the connections
con.Close
Set rst = Nothing
Set rst1 = Nothing
Set cat = Nothing
Set tbl = Nothing
Set fld = Nothing
Set con = Nothing
Exit Sub

ErrHandler:
'Close the connections
MsgBox "MakeCSV encountered error " & Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, "MakeCSV Encountered Error " & Err.Number
If rst.State = adStateOpen Then
 rst.Close
End If
If rst1.State = adStateOpen Then
 rst1.Close
End If
con.Close
Set rst = Nothing
Set rst1 = Nothing
Set cat = Nothing
Set tbl = Nothing
Set fld = Nothing
Set con = Nothing
Exit Sub

End Sub

Filed under: Programming, Technology |