Option Explicit
Sub CSV_toCSV(ByVal tablename As String)
Dim theTable As ListObject
Set theTable = ThisWorkbook.ActiveSheet.ListObjects(tablename)
toCSV_header theTable, ",", """", """"""
toCSV_data theTable, ", ", """", """"""
End Sub
Sub CSV_toDBInserts(ByVal tablename As String)
Dim theTable As ListObject
Set theTable = ThisWorkbook.ActiveSheet.ListObjects(tablename)
toCSV_header theTable, ", ", "", "", "INSERT INTO " & theTable.Name & " (", ") VALUES"
toCSV_data theTable, ", ", "'", "''", "(", "),", ");"
End Sub
Private Sub toCSV_header(ByRef table As ListObject, ByVal delimiter As String, ByVal quote As String, ByVal quoteWith As String, Optional ByVal prefix As String = "", Optional ByVal postfix As String = "")
Dim theTable As ListObject
Dim line As String
Dim curVal As String
Dim c As Integer
Dim first As Boolean
first = True
Set theTable = ThisWorkbook.ActiveSheet.ListObjects("thetable")
line = prefix
For c = 1 To theTable.ListColumns.Count
If first Then
first = False
Else
line = line & delimiter
End If
curVal = theTable.HeaderRowRange.Cells(1, c).Value
If Not quote = "" Then
curVal = Replace(curVal, quote, quoteWith)
End If
line = line & quote & curVal & quote
Next c
line = line & postfix
Debug.Print line
End Sub
Private Sub toCSV_data(ByRef table As ListObject, ByVal delimiter As String, ByVal quote As String, ByVal quoteWith As String, Optional ByVal prefix As String = "", Optional ByVal postfix As String = "", Optional ByVal globalPostfix As String = "")
Dim theTable As ListObject
Dim line As String
Dim curVal As String
Dim r, c, h As Integer
Dim first As Boolean
first = True
Set theTable = ThisWorkbook.ActiveSheet.ListObjects("thetable")
'Change the path and file name accordingly
'Open "/Users/hoffmd9/tmp" For Output As #1
For r = 1 To theTable.DataBodyRange.Rows.Count
line = prefix
For c = 1 To theTable.DataBodyRange.Columns.Count
If first Then
first = False
Else
line = line & delimiter
End If
curVal = theTable.DataBodyRange.Cells(r, c).Value
If Not quote = "" Then
curVal = Replace(curVal, quote, quoteWith)
End If
line = line & quote & curVal & quote
Next c
If r = theTable.ListRows.Count Then
line = line & globalPostfix
Else
line = line & postfix
End If
first = True
Debug.Print line
Next r
'Change the path and file name accordingly
'Open "/Users/hoffmd9/tmp" For Output As #1
'Write #1, CStr(Cells(i, j).Value);
'Close #1
End Sub