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]