csv macro

Option Explicit


Const DB_COLUMN_ROW As Integer = 1
Const DB_DATA_ROW As Integer = 3
Const DB_START_COLUMN As Integer = 1


Sub ExportCsv()
    On Error GoTo ERR_LINE
    
    Dim columnIndex As Integer
    Dim c As Range
    Dim csvHead As String
    Dim table As String
    
    columnIndex = DB_START_COLUMN
    
    Set c = Cells(DB_COLUMN_ROW, columnIndex)
    table = UCase(c.Comment.Text)
    
    While Trim(c.Value) <> ""
        csvHead = csvHead & UCase(Trim(c.Value)) & ","
        columnIndex = columnIndex + 1


        Set c = Cells(DB_COLUMN_ROW, columnIndex)
    Wend


    columnIndex = columnIndex - 1
    
    Dim csvNo As Long
    Dim csv As String
    csv = ThisWorkbook.Path & "\" & table & ".csv"
    
    csvNo = FreeFile
    Open csv For Output Access Write As #csvNo
    
    csvHead = Left(csvHead, Len(csvHead) - 1)
    Print #csvNo, csvHead
    
    Dim row As Integer
    row = DB_DATA_ROW
    Set c = Cells(row, DB_START_COLUMN)
    
    Dim i As Integer
    Dim dl As String
    
    While Trim(c.Value) <> ""
        dl = ""
        For i = DB_START_COLUMN To columnIndex
            dl = dl & "'" & Trim(Cells(row, i).Value) & "',"
        Next i
        
        dl = Left(dl, Len(dl) - 1)
        Print #csvNo, dl
        
        row = row + 1
        Set c = Cells(row, DB_START_COLUMN)
    Wend
    
    
    Debug.Print csvHead
    Debug.Print table
    
    Close #csvNo
    
    MsgBox "done"
    
    Exit Sub
    
ERR_LINE:
    MsgBox Err.Description, vbCritical + vbYesNo, "Error"
    If csv <> 0 Then
        Close #csvNo
    End If
End Sub