Vb6 Ms. Access: Export Table Ke File Csv (Comma Delimited) - Part 2

Lanjut dari Part 1 .... Mari kita coba, dikala run kita punya 2 delimiter yang bisa dipilih. Pilih sesuai keinginan lalu klik tombol Export CSV. Tentukan lokasi penyimpanan. Hasil yang tersimpan. Berikut ini pembanding bila dibuka dengan notepad dan excel. Kode selengkapnya: Option Explicit Dim oConn As New ADODB.Connection Dim rsData As New ADODB.Recordset Dim strConn As String Dim 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 String Dim i As Integer Dim r As Integer Open FileName For Output As #1 'tulis header dulu 'skip bab ini klo ga pengen header str = "" For i = 0 To rsData.Fields.Count - 1    str = str & rsData.Fields(i).Name    If i Then         str = str & Combo1.Text    End If Next Print #1, str 'tulis isi data rsData.MoveFirst For r = 0 To rsData.RecordCount - 1  str = ""   For i = 0 To rsData.Fields.Count - 1      str = str & rsData.Fields(i).Value      If i 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 dahulu 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.
Sumber http://rani-irsan.blogspot.com