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 > > >