Oh iya,
Kalau query di MS Access, ada kang Haer, kang Aksan, sama kang Opi yang
tahu detil seluk beluk trik query MS Access yang execute timenya singkat.
Monggo akang sedaya, sila turut sumbang saran. :)
Wassalam,
Kid.
2012/10/25 Mr. Kid <mr.nm...@gmail.com>
> Dear Jamal,
>
> Coba ganti prosedur SendToDB menjadi :
> (bagian yang hijau adalah tambahan untuk cek keberadaan data excel dalam
> database)
> (bagian merah adalah tambahan untuk sedikit memastikan keberadaan koneksi
> dan proses drop varibel dari memory)
> 'contoh insert into ke access memanfaatkan adodb
> 'pastikan library Microsoft ActiveX Data Object telah terinstall dikomputer
> Public Sub SendToDB(Optional bState As Boolean = False)
> Dim con As Object, rs As Object
> Dim sCon As String, sQuery As String, sQCek As String
> Dim rngQuery As Range, rng As Range
> Dim lRec As Long, lCount As Long
> Dim dblProc As Double
>
> With Sheet1
> lRec = WorksheetFunction.CountA(.Range("a1").EntireColumn) - 1
> If lRec < 1 Then
> MsgBox "Tidak ada data"
> Exit Sub
> End If
>
> dblProc = Timer 'set waktu
> mulai
> Set rngQuery = .Range("x11").Resize(lRec, 1) 'area teks
> query data yang akan dikirim
> .Range("x8").Copy rngQuery 'copy
> formula template query data
> .Calculate 'calculate
> sheet
> rngQuery.Value = rngQuery.Value 'di values
> End With
>
> 'misal kirim ke db bernama contoh_tulis.mdb
> 'karena rm.mdb akan digunakan untuk contoh ambil data yang bisa jadi
> nanti dibatasi jumlah baris excel
> sCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
> "Data Source=" & ThisWorkbook.Path & "\contoh_tulis.mdb" & ";"
> & _
> "Mode=Share Deny None;"
> Set con = CreateObject("ADODB.Connection") 'init object
> connection
> Set rs = CreateObject("ADODB.Recordset") 'init object
> recordset
> With con
> .Open sCon 'buka koneksi
> If .State = 1 Then 'koneksi OK ?
> lCount = 0
> 'query insert into
> sQuery = "INSERT INTO GR " & _
>
> "(GR,GR_Date,Arrival_No,Arrival_Time,Police_No,Lokasi,Variety,Gudang,Netto,Staff"
> & _
>
> ",CVL,Decompose,Garbage,Abnormal,Young,Black,Green,Germinated,Telur,Rafaction,KA,QC)"
> sQCek = "SELECT dt1.GR FROM GR as dt1 WHERE
> dt1.GR=" 'query select untuk cek
> For Each rng In rngQuery
> If LenB(rng.Value) <> 0 Then
> 'ambil recordset berdasar GR nilai GR yang ada di
> sheet
> 'kolom GR di sheet (lompat 22 kolom kekiri dari kolom
> X)
> 'recordset dengan cursor keyset
> rs.Open sQCek & "'" & rng.Offset(0, -22).Value & "'",
> con, adOpenKeyset
> If rs.RecordCount = 0
> Then 'belum ada datanya ?
> lCount = lCount +
> 1 'counter
> .Execute sQuery & " " &
> rng.Value 'tulis data baru
> End If
>
> rs.Close 'close
> recordset
> End If
> Next rng
> rngQuery.Delete xlShiftUp 'hapus kolom query
> .Close 'tutup koneksi
> End If
> End With
> Set con = Nothing 'drop variabel dari memory
> Set rs = Nothing 'drop variabel dari memory
> dblProc = Timer - dblProc 'set
> waktu selesai
> MsgBox "Done." & vbCrLf & _
> lCount & " record(s) in " & dblProc & " second",
> vbInformation, "Insert Into"
> End Sub
>
> Cara lainnya adalah menyusun query insert dengan bagian select yang di left
> atau right join dengan tabel di database berdasar kolom kuncinya yang nilai
> kunci
> di tabel databasenya bernilai NULL. Pada beberapa database engine, bisa
> juga menggunakan Except query.
>
> Wassalam,
> Kid.
>
> 2012/10/25 Xanchel <xanch...@yahoo.co.id>
>
>> **
>>
>>
>> Dear om mr.Kid, om heru.
>>
>> maaf saya nyimpang pertanyaan om heru.
>> saya coba klik upload "2x" ( klik upload setelah selesai saya klik lagi"
>> terlihat data yg sama di upload sebanyak 2x. jika saya ingin supaya sebelum
>> upload, check data yg ada di .mdb dan upload hanya yg belum ada saja di
>> .mdb bagaiaman ya om ?
>>
>> salam.
>> Jamal
>>
>>
>>
>
