04/02/2020, 23:05
(04/02/2020, 22:55)yahyamacit yazdı: [ -> ]Sayın @feraz hocam bahsettiğim durumla ilgili dosyayı gönderemiyorum. Kısıtlama var herhalde. Sadece progressbarı görmek için aktif durumda tuttum. Şimdi Excel dosyasındaki kayıt sayısını 20-30 a düşürüp tekrar denediğimizde değer 100 e çıkmıyor. Veya ben biryerlerde yanlış yapıyorum.
Kod:Dim say As Long, say1 As Long
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSql 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 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ü)
If DCount("[kod]", "Tablo1", "[kod] = '" & rs(0) & "'") > 0 Then 'Eger Tablo1 deki kod sütununda excelden alinan recordset icindeki veri mevcutsa
CurrentDb.Execute _
"UPDATE Tablo1 SET [kod] = '" & rs(0) & "'," & _
"[ad] = '" & rs(1) & "'," & _
"[yas] = '" & rs(2) & "'," & _
"[Tarih] = '" & rs(1) & "'" & _
"WHERE [kod] = '" & rs(0) & "'"
say = say + 1
ElseIf DCount("[kod]", "Tablo1", "[kod] = '" & rs(0) & "'") = 0 Then 'Eger Tablo1 deki kod sütununda excelden alinan recordset icindeki veri mevcut degilse
CurrentDb.Execute _
"INSERT INTO Tablo1" _
& " ([kod], [ad], [yas], [tarih])" _
& " VALUES ( '" & rs(0) & "' , '" & rs(1) & "' , " & rs(2) & ", '" & Format(rs(3), "dd.mm.yyyy") & "' );" 'Kayit ekle exceldekinde olup accesste mevcut olmayan veri
say1 = say1 + 1
End If
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
sSqlCount = "select count(*) from [Sayfa1$B3:E] "
Yukarıdaki yeri
sSqlCount = "select count(*) from [Sayfa1$B3:B1048576] "
İle değiştirip denermisiniz.Ben yolladığımız kodu bugün deneyemem.Ayrıca upload sitesine dosyayı yükleyip buraya link atabilirsiniz.