Artık altlarda çıkıyor önceden yazdığım olay
Dim kopyala
kopyala = Format(Now(), "dd_mm_yyyy_hh_mm_ss") & "_Tablo1"
DoCmd.CopyObject , kopyala, acTable, "Tablo1"
CurrentDb.Execute " delete from tablo1"
CurrentDb.Execute " INSERT INTO Tablo1 ( KOD, AD, yas, tarih ) " & _
" SELECT KOD, AD, yas, tarih " & _
" FROM " & kopyala & " where [KOD] Is Not Null"
DoCmd.DeleteObject acTable, kopyala
Üstteki kodlarla yaptım işlemi.Özetle Tablo1 in formatlı isim olarak frmatlı kopyalattım.
Bu tabloyada excelde olup tablo1 de olmayanları aktardım.
Sonrada bağlantı ile alınan exceldeki verileri tablo1e aktardım sonundada kopyala değişkeniyle alınan tablodakileri tablo1 e aktarınaca en alta atmış oldu.Ve oluşturulan tablo silindi.
Kodların tamamı altta.
Option Compare Database
Private Sub Form_Current()
lbyzde.Visible = False
End Sub
Private Sub Komut6_Click()
'hy_Geçici_tablo_var_mý_varsa_sil_____
If Not IsNull(DLookup("Name", "MSysObjects", "Name='TmpTablo'")) Then DoCmd.DeleteObject acTable, "TmpTablo"
'hy_tablo_kontrol____________________Bitti
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 -------------------------------------------------------------------------------------------------------
DoCmd.TransferSpreadsheet TransferType:=acLink, _
TableName:="TmpTablo", _
SpreadsheetType:=10, _
FileName:=yahya, _
HasfieldNames:=True, _
Range:="B3:E" '"Hy bin 2!B3:E"
'hy Tablo Boþ Mu_____________
Dim SayRS As New ADODB.Recordset
Dim SaySql As String
SaySql = "select * from TmpTablo" 'öðretmenler tablosundan öðretmen seç
SayRS.Open SaySql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
KytSay = SayRS(0)
Krt = " where [" & SayRS(0).Name & "] Is Not Null"
SayRS.Close
SayRS.Open SaySql & Krt, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
If SayRS.RecordCount = 0 Then
DoCmd.DeleteObject acTable, "TmpTablo"
MsgBox "Tabloda veri yok"
Exit Sub
End If
SayRS.Close
'hy Excel Boþ Mu_____________Bitti
KytSy1 = DCount("*", "Tablo1")
CurrentDb.Execute " delete from tablo1 where [KOD] in (select [KOD] from TmpTablo)"
Dim kopyala
kopyala = Format(Now(), "dd_mm_yyyy_hh_mm_ss") & "_Tablo1"
DoCmd.CopyObject , kopyala, acTable, "Tablo1"
CurrentDb.Execute " delete from tablo1"
KytSy1Gncl = KytSy1 - DCount("*", "Tablo1")
CurrentDb.Execute " INSERT INTO Tablo1 ( KOD, AD, yas, tarih ) " & _
" SELECT TmpTablo.KOD, TmpTablo.AD, TmpTablo.YAÞ, TmpTablo.Tarh " & _
" FROM TmpTablo where [KOD] Is Not Null"
CurrentDb.Execute " INSERT INTO Tablo1 ( KOD, AD, yas, tarih ) " & _
" SELECT KOD, AD, yas, tarih " & _
" FROM " & kopyala & " where [KOD] Is Not Null"
KytSyEk = DCount("*", "Tablo1") - KytSy1
Me.Form2.Requery
CurrentDb.TableDefs.Refresh
DoCmd.DeleteObject acTable, "TmpTablo"
DoCmd.DeleteObject acTable, kopyala
MsgBox "Transfer bitti" & Chr(10) & _
"Güncellenen Kayýt Sayýsý : " & KytSy1Gncl & Chr(10) & _
"Eklenen Kayýt Sayýsý : " & KytSyEk & Chr(10) & _
"Toplam Kayýt Sayýsý : " & DCount("*", "Tablo1")
End Sub