VB6 Ms. Access: Import dari CSV File - Part 3

Artikel ini kode lanjutan dari Part 2, yang berisi kode selengkapnya proses import csv ke tabel database access.

Option Explicit

'Untuk menampilkan CSV
Dim rsTemp As ADODB.Recordset
Dim strFileName As String
Dim fnum As Integer
Dim strFileValue As String
Dim lines() As String
Dim one_line() As String 
Dim num_rows As Long 
Dim num_cols As Long 
Dim r As Long
Dim c As Long

'Koneksi ADO Ms Access 
Dim oConn As New ADODB.Connection
Dim strConn As String 
Dim rsData As ADODB.Recordset 
Dim SQL As String
Dim i As Integer


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


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


Private Sub Form_Load()

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & App.Path & "\latihan.mdb;" & _
          "Persist Security Info=False"
         
Load_Data

Me.Caption = "Import Data Item"
Label1.Caption = "Delimiter"
With Combo1
    .AddItem ","
    .AddItem ";"
    .ListIndex = 0
End With
Text1.Text = ""
Text1.Locked = True
Command1.Caption = "Browse..."
DataGrid1.Caption = "Data CSV"
Command2.Caption = "Begin Import!"
Command2.Enabled = False
DataGrid2.Caption = "Data Access"

End Sub


Sub Data_Temp(arr() As String)

Set rsTemp = New ADODB.Recordset

For i = 0 To UBound(arr)
rsTemp.Fields.Append arr(i), adVarChar, 255, adFldIsNullable
Next

rsTemp.Open
Set DataGrid1.DataSource = rsTemp

End Sub


Private Sub Command1_Click()

CommonDialog1.Filter = "Comma Delimited (*.csv)|*.csv"
CommonDialog1.ShowOpen

Text1.Text = CommonDialog1.FileName

If Me.Text1.Text = "" Then Exit Sub

strFileName = Text1.Text

' mengambil isi file
fnum = FreeFile
Open strFileName For Input As fnum
strFileValue = Input$(LOF(fnum), #fnum)
Close fnum

' memecah baris ke variable lines.
lines = Split(strFileValue, vbCrLf)

' jumlah baris
num_rows = UBound(lines)

'header/nama kolom
one_line = Split(lines(0), Me.Combo1.Text)
num_cols = UBound(one_line)
Data_Temp one_line

' input nilai ke recordset
For r = 1 To num_rows - 1
    rsTemp.AddNew
    one_line = Split(lines(r), Combo1.Text)
    For c = 0 To num_cols
        rsTemp.Fields(c).Value = one_line(c)
    Next
    rsTemp.Update
Next
rsTemp.MoveFirst
Command2.Enabled = True
End Sub


Sub RunQuery(sSQL As String)
Dim cmd As New ADODB.Command
Set cmd = New ADODB.Command
  With cmd
    .ActiveConnection = strConn
    .CommandType = adCmdText
    .CommandText = sSQL
    .Execute
  End With
End Sub

 
Private Sub Command2_Click()
On Error GoTo errHandler
rsTemp.MoveFirst
For i = 0 To rsTemp.RecordCount - 1
    RunQuery "INSERT INTO category " & _
             "(categorycode, categoryname) VALUES " & _
             "('" & rsTemp.Fields(0).Value & "', " & _
             "'" & rsTemp.Fields(1).Value & "')"
    rsTemp.MoveNext
Next

rsTemp.MoveFirst
MsgBox "Proses Import Selesai"

Load_Data

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

Click here if you like this article.