VB6 Ms. Access: Export Table ke File CSV (Comma Delimited) - Part 2

Lanjut dari Part 1....

Mari kita coba, saat run kita punya 2 delimiter yang bisa dipilih. Pilih sesuai keinginan kemudian klik tombol Export CSV.

Tentukan lokasi penyimpanan.

Hasil yang tersimpan.

Berikut ini pembanding jika dibuka dengan notepad dan excel.

Kode selengkapnya:
Option Explicit
Dim oConn As New ADODB.Connection
Dim rsData As New ADODB.Recordset
Dim strConn As StringDim SQL As String

Private Sub Form_Load()
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & App.Path & "\latihan.mdb;" & _
          "Persist Security Info=False"
ListTables


Command1.Caption = "Export CSV"
Label1.Caption = "Delimiter"
With Combo1
    .AddItem ","
    .AddItem ";"
    .ListIndex = 0 
End With

End Sub

Sub Open_Connection()
Set oConn = New ADODB.Connection
oConn.ConnectionString = strConn
oConn.Open
End Sub

Sub ListTables()
Open_Connection
Dim rs As ADODB.Recordset

List1.Clear
Set rs = oConn.OpenSchema(adSchemaTables, _
         Array(Empty, Empty, Empty, "Table"))
Do While Not rs.EOF
    List1.AddItem rs!TABLE_NAME
    rs.MoveNext
Loop

rs.Close
oConn.Close

List1.ListIndex = 0
End Sub

Sub Load_Data(TableName As String)
Open_Connection
Set rsData = New ADODB.Recordset
SQL = "SELECT * FROM " & TableName
With rsData
    .CursorLocation = adUseClient
    .Open SQL, oConn, adOpenDynamic, adLockOptimistic
    .ActiveConnection = Nothing
End With
Set DataGrid1.DataSource = rsData
oConn.Close
End Sub

Private Sub List1_Click()
Load_Data List1.Text
End Sub

Sub SaveToFile(FileName As String)
Dim str As StringDim i As IntegerDim r As Integer

Open FileName For Output As #1

'tulis header dulu
'skip bagian ini klo ga pengen header
str = ""
For i = 0 To rsData.Fields.Count - 1
   str = str & rsData.Fields(i).Name
   If i < rsData.Fields.Count - 1 Then
        str = str & Combo1.Text
   End If
Next
Print #1, str

'tulis isi data
rsData.MoveFirstFor r = 0 To rsData.RecordCount - 1
 str = ""
 For i = 0 To rsData.Fields.Count - 1
     str = str & rsData.Fields(i).Value
     If i < rsData.Fields.Count - 1 Then
        str = str & Combo1.Text
     End If
 Next
 Print #1, str
 rsData.MoveNext
Next

Close #1

End Sub

Private Sub Command1_Click()
On Error GoTo errHandler

Dim strFileName As String

'cek dulu apakah data kosong
If rsData.RecordCount = 0 Then
   MsgBox "Data Kosong": Exit Sub
End If

CommonDialog1.FileName = "Export.csv"
CommonDialog1.DefaultExt = "csv"
CommonDialog1.Filter = "Comma delimited (*.csv)"
CommonDialog1.ShowSave

If CommonDialog1.FileTitle = "" Then Exit Sub
strFileName = CommonDialog1.FileName

If Dir(strFileName) <> "" Then
 If MsgBox("File exists, Overwrite?", vbYesNo, _
           "Confirmation") = vbNo Then Exit Sub
End If

SaveToFile strFileName


Exit Sub
errHandler:
MsgBox "Error: " & Err.Description
End Sub

Click here if you like this article.