Skip to main content

AccessTr.neT


Kayıt Güncelleme

Kayıt Güncelleme

#2
Bahsettiğiniz işlem, "aliste1" isimli form için yapılmıştır.

Butonun tıklandığında olayındaki kodu aşağıdaki ile değiştiriniz.



Dim IE As Object
Dim HTML_Body As Object, HTML_Tables As Object, MyTable As Object
Dim HTML_TableRows As Object
Dim X, Y, Z, Guncel, Yeni As Integer
     
Set IE = Me.WebBrowser1
Set HTML_Body = IE.Document.All
Set HTML_Tables = HTML_Body.tags("Table")
Set MyTable = HTML_Tables(41)
Set HTML_TableRows = MyTable.GetElementsByTagName("td")

For Each MyRow In HTML_TableRows
X = X + 1
Next

Z = (X - 8) / 8

ReDim sorgu(5, Z - 1)  
 
X = 0
Guncel = 0
Yeni = 0

For X = 0 To Z - 1
Y = 1 + (1 * X)
sorgu(0, X) = MyTable.Rows(Y).Cells(1).innerText
sorgu(1, X) = MyTable.Rows(Y).Cells(2).innerText
sorgu(2, X) = MyTable.Rows(Y).Cells(3).innerText
sorgu(3, X) = MyTable.Rows(Y).Cells(4).innerText
sorgu(4, X) = MyTable.Rows(Y).Cells(5).innerText
Next X
       
 '  Me.tumalani = Y + X - 3

Dim rc As DAO.Recordset
Set rc = CurrentDb.OpenRecordset("tliste1")
 
X = 0
 
For X = 0 To Z - 1

strSQl = "SELECT * FROM tliste1 "
Set rstkayit = New ADODB.Recordset
rstkayit.Open strSQl, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

With rstkayit
.Find "[tcno]=" & "'" & sorgu(0, X) & "'"

If Not rstkayit.EOF Then
.Fields("adi") = sorgu(1, X)
.Fields("asyd") = sorgu(2, X)
.Fields("okulno") = sorgu(3, X)
.Fields("sinif") = Left(sorgu(4, X), InStr(1, sorgu(4, X), ".") - 1)
.Fields("sube") = Left(Trim(Mid(sorgu(4, X), InStr(1, sorgu(4, X), "/") + 1)), 1)
.Fields("alani") = Left(Trim(Mid(sorgu(4, X), InStr(1, sorgu(4, X), "(") + 1)), InStr(1, Trim(Mid(sorgu(4, X), InStr(1, sorgu(4, X), "(") + 1)), ")") - 1)
Guncel = Guncel + 1
.Update
Else
.AddNew
.Fields("tcno") = sorgu(0, X)
.Fields("adi") = sorgu(1, X)
.Fields("asyd") = sorgu(2, X)
.Fields("okulno") = sorgu(3, X)
.Fields("sinif") = Left(sorgu(4, X), InStr(1, sorgu(4, X), ".") - 1)
.Fields("sube") = Left(Trim(Mid(sorgu(4, X), InStr(1, sorgu(4, X), "/") + 1)), 1)
.Fields("alani") = Left(Trim(Mid(sorgu(4, X), InStr(1, sorgu(4, X), "(") + 1)), InStr(1, Trim(Mid(sorgu(4, X), InStr(1, sorgu(4, X), "(") + 1)), ")") - 1)
Yeni = Yeni + 1
.Update
End If
End With
Next X
 
MsgBox ("aktarım tamamlanmıştır," & Chr(13) & Chr(10) & "Yeni Eklenen Kayıt: " & Yeni & " Adet," & Chr(13) & Chr(10) & "Güncellenen Kayıt: " & Guncel & " Adet."), vbInformation, "AKTARIM MESAJI"
 
Set rc = Nothing
Set HTML_Body = Nothing
Set HTML_Tables = Nothing
Set MyTable = Nothing
Set HTML_TableRows = Nothing
Set HTML_TableDivisions = Nothing
Set IE = Nothing
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da

Bu Konudaki Yorumlar
Kayıt Güncelleme - Yazar: idrisy - 27/08/2015, 00:39
Cvp: Kayıt Güncelleme - Yazar: ozanakkaya - 27/08/2015, 06:17
Cvp: Kayıt Güncelleme - Yazar: idrisy - 27/08/2015, 12:47
Task