sayın @feraz addnew ve update yöntemleriyle yapmaya çalıştım
29. mesajdaki dosyayı baz aldım
dilerim işinize yarar
Dosya sona tasinmistir:
https://accesstr.net/konu-excelden-veri-...#pid163964

    Dim say As Long, say1 As Long

    Dim con As ADODB.Connection

    Dim rs As ADODB.Recordset

    Dim rsK As ADODB.Recordset

    Dim sSql, SrgK As String, sSqlCount As String, adet As Long

    Dim varFile As Variant

    Dim yahya As String

    Dim fDialog As Office.FileDialog



    Set rs = New ADODB.Recordset

    Set rsK = New ADODB.Recordset

    Set con = New ADODB.Connection

    



       sSql = "select [KOD],[AD],[YAŞ],[Tarh] from [Sayfa1$B3:E] where [KOD] Is Not Null" '



      sSqlCount = "select count(*) from [Sayfa1$B3:E] " 'Exceldeki satir sayisi

        

'Dosya ac -------------------------------------------------------------------------------------------------------

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)



  With fDialog

      .AllowMultiSelect = False

        .Title = "Lütfen Aktaraca?ynyz Bilgilerin Bulundu?u Excel Dosyasyny Seçin"



        .Filters.Clear

        .Filters.Add "All Files", "*.*"

        .Filters.Add "Excel 2003", "*.xls"

        .Filters.Add "Excel 2007", "*.xlsx"





          If .Show = True Then

            For Each varFile In .SelectedItems

                yahya = varFile

            Next

        End If

    End With



    If yahya = "" Or IsNull(yahya) Then

        MsgBox "Dosya secilmedigi icin iptal edildi...", vbCritical, "iptal"

        Set fDialog = Nothing

        Exit Sub

    End If

    

    Me.ProgressBar3.Visible = True

    Me.lbyzde.Visible = True

    Me.lbyzde.Top = Me.ProgressBar3.Top + 10

    Me.lbyzde.Left = (Me.ProgressBar3.Left + 10) + Me.ProgressBar3.Width

    

  'Dosya ac sonu -------------------------------------------------------------------------------------------------------

  

    con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & yahya & ";extended properties=""excel 12.0;hdr=Yes;imex=1"""

  CurrentDb.TableDefs.Refresh

    

    rs.CursorLocation = adUseClient

    rs.CursorType = adOpenKeyset

    rs.LockType = adLockOptimistic

    rs.Open sSqlCount, con

    adet = rs(0)

    rs.Close

    

    rs.Open sSql, con

 

   Do While Not rs.EOF And Not rs.BOF 'Tablo güncelleme icin(Exceldeki recordseti icine alinan veriler icin döngü)

'hy AddNew ve Update Yöntemi________________________________________ 

       SrgK = " select * from tablo1 where [kod]='" & Replace(rs(0), "'", "''") & "'"

       rsK.Open SrgK, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

       If rsK.RecordCount = 0 Then 'rsK.MoveFirst

            rsK.AddNew

            rsK(0) = rs(0)

            rsK(1) = rs(1)

            rsK(2) = rs(2)

            rsK(3) = rs(3)

            rsK.Update

            say1 = say1 + 1

       Else

            rsK(1) = rs(1)

            rsK(2) = rs(2)

            rsK(3) = rs(3)

            rsK.Update

            say = say + 1

       End If

       rsK.Close

'hy AddNew ve Update Yöntemi________________________________________BİTTİ  

     rs.MoveNext

        DoEvents

      

      Me.ProgressBar3.Value = ((say + say1) / adet) * 100

      Me.lbyzde.Caption = Int(Me.ProgressBar3.Value) & " %"

    

    Loop



  Me.ProgressBar3.Visible = False

  Me.lbyzde.Visible = False

  Form2.Form.Requery

  CurrentDb.TableDefs.Refresh

  MsgBox "Eklenen kayit sayisi=" & say1, vbInformation, "Bilgi"

  MsgBox "Düzeltilen kayit sayisi=" & say, vbInformation, "Bilgi"

  MsgBox "Exceldeki Toplam satir sayisi=" & adet, vbInformation, "Bilgi"





    rs.Close

    con.Close

    Set rs = Nothing

    Set fDialog = Nothing

---

Bu da hızlı yöntem görsel olarak işe yaramaz ama diğer yöntemden çok daha hızlı

    Dim varFile As Variant

    Dim yahya As String

    Dim fDialog As Office.FileDialog



'Dosya ac -------------------------------------------------------------------------------------------------------

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)



  With fDialog

      .AllowMultiSelect = False

        .Title = "Lütfen Aktaraca?ynyz Bilgilerin Bulundu?u Excel Dosyasyny Seçin"



        .Filters.Clear

        .Filters.Add "All Files", "*.*"

        .Filters.Add "Excel 2003", "*.xls"

        .Filters.Add "Excel 2007", "*.xlsx"





          If .Show = True Then

            For Each varFile In .SelectedItems

                yahya = varFile

            Next

        End If

    End With



    If yahya = "" Or IsNull(yahya) Then

        MsgBox "Dosya secilmedigi icin iptal edildi...", vbCritical, "iptal"

        Set fDialog = Nothing

        Exit Sub

    End If

    

    Me.ProgressBar3.Visible = True

    Me.lbyzde.Visible = True

    Me.lbyzde.Top = Me.ProgressBar3.Top + 10

    Me.lbyzde.Left = (Me.ProgressBar3.Left + 10) + Me.ProgressBar3.Width

    

  'Dosya ac sonu -------------------------------------------------------------------------------------------------------

      

'      dizi = rs.GetRows

DoCmd.TransferSpreadsheet acLink, 10, "TmpTablo", yahya, True, "b3:E" 

CurrentDb.Execute " delete from tablo1 where [KOD] in (select [KOD] from TmpTablo)"

CurrentDb.Execute " INSERT INTO Tablo1 ( KOD, AD, yas, tarih ) " & _

                " SELECT TmpTablo.KOD, TmpTablo.AD, TmpTablo.YAŞ, TmpTablo.Tarh " & _

                " FROM TmpTablo"

Me.Form2.Requery

DoCmd.DeleteObject acTable, "TmpTablo"

  CurrentDb.TableDefs.Refresh



MsgBox ""

[attachment=31349]