Skip to main content

AccessTr.neT


Excelden Veri Alma Ve Kaydı Güncelleme

Excelden Veri Alma Ve Kaydı Güncelleme

#49
Arkadaşlar çok yardımcı oldunuz sağolun. Bir kaç sorum olacak. Progressbar tam çalışmıyor sanırım. 'adet' değişkeni kayıt 303 değerini okuyor. Sebebi ne olabilir. 
adet=rs(0)
progressbar3.visible=true 
yapınca yarıda kalıyor.
Cevapla
#50
(03/02/2020, 23:48)yahyamacit yazdı: Arkadaşlar çok yardımcı oldunuz sağolun. Bir kaç sorum olacak. Progressbar tam çalışmıyor sanırım. 'adet' değişkeni kayıt 303 değerini okuyor. Sebebi ne olabilir. 
Exceldeki verilerin adedi 303 olduğu için.
(03/02/2020, 23:52)yahyamacit yazdı: adet=rs(0)
progressbar3.visible=true 
yapınca yarıda kalıyor.
sSqlCount = "select count(*) from [Sayfa1$B3:E] "

Yukarıdaki kod ado da kaç adet olduğunu bulmak için kullanılır count ile.

rs.Open sSqlCount, con bununlada sorgu yapılır.

adet = rs(0)  adet değişkeninede bulunan değer böyle atanır.
adet=303 olur.

Me.ProgressBar3.Value = ((say + say1) / adet) * 100 bu kod dögü içinde kullanılır.
Normalde say + say1 yerine başka bir değişken daha atanıp say3 gibi mesela say3 de yazılırdı.say3 de say3=say3+1 diye giderdi gerek yok diye kullanmadım.

Döngü ilk çalıştığında say + say1 buranın sonucu 1 olur ve 2,3,4.....diye döngü bütene kadar devam eder.

Döngü bitince say+say1 sonucu 303 olur bu durumdada
((say + say1) / adet) * 100 yani ((303) / 303) * 100 sonucu 100 olur.

Progressbarın max değeride 100 olduğu için kodda hata yok.
Cevapla
#51
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]
Cevapla
#52
@berduş üstad şöyle denermisiniz her iki kodlarınız içinde.

Tablodaki ilk 5 yada ilk 3 farketmez A5 yazıp kodu çalıştırırmısınız.
Normalde hepsi aynı olmalı.
Cevapla
#53
dediğiniz şekilde A5 yazdım Excel dosyasında A5 olduğu için silip Excel dosyasındaki tek değeri ekledi
sorun nerede?
Cevapla
#54
(04/02/2020, 17:33)berduş yazdı: dediğiniz şekilde A5 yazdım Excel dosyasında A5 olduğu için silip Excel dosyasındaki tek değeri ekledi
sorun nerede?

Konuyu ya siz yada ben yanlış anladım bu durumda.
Benim anladıpım excelin kod sütununda A5 ve yan hücreleri ne ise Access tablodada o olmalı.yani A1,mehmet1,20,01.01.2020 ise ve acces tablodada A1 varsa exceldekiyle değişecek.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task