Sunday, June 17, 2012

Custom File Untuk Keperluan Import Database

''Gunakan editor terbaik dari Microsoft yakni Notepad
''Tulis seperti di bawah ini
'1, Description 1 ,1,100.00,3/1/1998
'2, Description 2 ,2,200.00,3/2/1998
'Simpan dengan nama c:\test.txt.

Private Sub Command1_Click()
Dim F As Long, sLine As String, A(0 To 4) As String
Dim db As Database, rs As Recordset
F = FreeFile
Open "c:\test.txt" For Input As F
Set db = CurrentDb
Set db = DBEngine(0).OpenDatabase("biblio.mdb")
On Error Resume Next
db.Execute "DROP TABLE TestImport"
On Error GoTo 0
db.Execute "CREATE TABLE TestImport (ID LONG, [Desc] TEXT (50), " & "Qty LONG, Cost CURRENCY, OrdDate DATETIME)"
Set rs = db.OpenRecordset("TestImport", dbOpenTable)
Do While Not EOF(F)
Line Input #F, sLine
ParseToArray sLine, A()
rs.AddNew
rs(0) = Val(A(0))
rs(1) = A(1)
rs(2) = Val(A(2))
rs(3) = Val(A(3))
rs(4) = CDate(A(4))
rs.Update
Loop
rs.Close
db.Close
Close #F
End Sub

Sub ParseToArray(sLine As String, A() As String)
Dim P As Long, LastPos As Long, I As Long
P = InStr(sLine, ",")
Do While P
A(I) = Mid$(sLine, LastPos + 1, P - LastPos - 1)
LastPos = P
I = I + 1
P = InStr(LastPos + 1, sLine, ",", vbBinaryCompare)
Loop
A(I) = Mid$(sLine, LastPos + 1)
End Sub