Örnek dosya sütun sayısı fazla 4 sütunluk olsaydı daha iyi olurdu
Kodlar zaten sizin.
![[Resim: xcitzxbf.gif]](https://s19.directupload.net/images/200208/xcitzxbf.gif)
Option Compare Database
Dim varFile As Variant
Dim yahya As String
Dim fDialog As Office.FileDialog
Dim SayRS As New ADODB.Recordset
Dim SaySql As String
Private Sub ExcelAl1_Click()
Dim Guncelle As String, al As String
Guncelle = " UPDATE TmpTablo INNER JOIN tesisler ON TmpTablo.KOD = tesisler.kod " & _
" SET " & _
" tesisler.kaynak = [TmpTablo]![Kaynak], " & _
" tesisler.Tarih = [TmpTablo]![Tarih], " & _
" tesisler.tesis = [TmpTablo]![Tesis], " & _
" tesisler.bolum = [TmpTablo]![Yer/Bölüm], " & _
" tesisler.tespit_eden = [TmpTablo]![Tespit Yapan], " & _
" tesisler.gozlem = [TmpTablo]![Uygunsuzluk/Ramak Kala/Gözlem], " & _
" tesisler.oneriler = [TmpTablo]![Önerilen Aksiyon], " & _
" tesisler.sorumlu = [TmpTablo]![sorumlu], " & _
" tesisler.termin_tarihi = [TmpTablo]![Termin tarihi], " & _
" tesisler.sorumlu_gorusu = [TmpTablo]![Sorumlu Görüşü/Kararı], " & _
" tesisler.tamamlama_tarihi = [TmpTablo]![Tamamlama Tarihi], " & _
" tesisler.durum = [TmpTablo]![Durum] " & _
" WHERE (((TmpTablo.KOD) In (SELECT tesisler.kod " & _
" FROM TmpTablo INNER JOIN tesisler ON TmpTablo.KOD = tesisler.kod " & _
" WHERE ((nz([tesisler]![kaynak] & [tesisler]![tarih] & [tesisler]![tesis] & [tesisler]![bolum] & " & _
" [tesisler]![tespit_eden] & [tesisler]![gozlem] & [tesisler]![oneriler] & [tesisler]![sorumlu] & " & _
" [tesisler]![termin_tarihi] & [tesisler]![sorumlu_gorusu] & [tesisler]![tamamlama_tarihi] & " & _
" [tesisler]![durum],"")<> " & _
" nz([TmpTablo]![Kaynak] & [TmpTablo]![Tarih] & [TmpTablo]![Tesis] & [TmpTablo]![Yer/Bölüm] & " & _
" [TmpTablo]![Tespit Yapan] & [TmpTablo]![Uygunsuzluk/Ramak Kala/Gözlem] & " & _
" [TmpTablo]![Önerilen Aksiyon] & [TmpTablo]![Sorumlu] & [TmpTablo]![Termin Tarihi] & " & _
" [TmpTablo]![Sorumlu Görüşü/Kararı] & [TmpTablo]![Tamamlama Tarihi] & [TmpTablo]![Durum],""))) )));"
al = " INSERT INTO tesisler ( kod, kaynak, tarih, tesis, bolum, Tespit_eden, gozlem, oneriler, sorumlu, termin_tarihi, sorumlu_gorusu, tamamlama_tarihi, durum )" & _
" SELECT TmpTablo.KOD, TmpTablo.Kaynak, TmpTablo.Tarih, TmpTablo.Tesis, TmpTablo.[Yer/Bölüm], TmpTablo.[Tespit Yapan], TmpTablo.[Uygunsuzluk/Ramak Kala/Gözlem], TmpTablo.[Önerilen Aksiyon], TmpTablo.sorumlu, TmpTablo.[Termin tarihi], TmpTablo.[Sorumlu Görüşü/Kararı], TmpTablo.[Tamamlama Tarihi], TmpTablo.Durum" & _
" FROM tesisler RIGHT JOIN TmpTablo ON tesisler.kod = TmpTablo.KOD" & _
" WHERE (((TmpTablo.KOD) Is Not Null) AND ((tesisler.kod) Is Null))"
Call AlVeGuncelle(Guncelle, al, 3)
End Sub
Private Sub ExcelSadeceAl_Click()
Dim SadeceEkle As String
CurrentDb.Execute "Delete * from tesisler"
SadeceEkle = " INSERT INTO tesisler ( kod, kaynak, tarih, tesis, bolum, Tespit_eden, gozlem, oneriler, sorumlu, termin_tarihi, sorumlu_gorusu, tamamlama_tarihi, durum )" & _
" SELECT TmpTablo.KOD, TmpTablo.Kaynak, TmpTablo.Tarih, TmpTablo.Tesis, TmpTablo.[Yer/Bölüm], TmpTablo.[Tespit Yapan], TmpTablo.[Uygunsuzluk/Ramak Kala/Gözlem], TmpTablo.[Önerilen Aksiyon], TmpTablo.sorumlu, TmpTablo.[Termin tarihi], TmpTablo.[Sorumlu Görüşü/Kararı], TmpTablo.[Tamamlama Tarihi], TmpTablo.Durum" & _
" FROM tesisler RIGHT JOIN TmpTablo ON tesisler.kod = TmpTablo.KOD" & _
" WHERE (((TmpTablo.KOD) Is Not Null) AND ((tesisler.kod) Is Null))"
Call AlVeGuncelle(SadeceEkle, "", 1)
End Sub
Private Sub ExcelSadeceGuncelle_Click()
Dim SadeceGuncelle As String
SadeceGuncelle = " UPDATE TmpTablo INNER JOIN tesisler ON TmpTablo.KOD = tesisler.kod " & _
" SET " & _
" tesisler.kaynak = [TmpTablo]![Kaynak], " & _
" tesisler.Tarih = [TmpTablo]![Tarih], " & _
" tesisler.tesis = [TmpTablo]![Tesis], " & _
" tesisler.bolum = [TmpTablo]![Yer/Bölüm], " & _
" tesisler.tespit_eden = [TmpTablo]![Tespit Yapan], " & _
" tesisler.gozlem = [TmpTablo]![Uygunsuzluk/Ramak Kala/Gözlem], " & _
" tesisler.oneriler = [TmpTablo]![Önerilen Aksiyon], " & _
" tesisler.sorumlu = [TmpTablo]![sorumlu], " & _
" tesisler.termin_tarihi = [TmpTablo]![Termin tarihi], " & _
" tesisler.sorumlu_gorusu = [TmpTablo]![Sorumlu Görüşü/Kararı], " & _
" tesisler.tamamlama_tarihi = [TmpTablo]![Tamamlama Tarihi], " & _
" tesisler.durum = [TmpTablo]![Durum] " & _
" WHERE (((TmpTablo.KOD) In (SELECT tesisler.kod " & _
" FROM TmpTablo INNER JOIN tesisler ON TmpTablo.KOD = tesisler.kod " & _
" WHERE ((nz([tesisler]![kaynak] & [tesisler]![tarih] & [tesisler]![tesis] & [tesisler]![bolum] & " & _
" [tesisler]![tespit_eden] & [tesisler]![gozlem] & [tesisler]![oneriler] & [tesisler]![sorumlu] & " & _
" [tesisler]![termin_tarihi] & [tesisler]![sorumlu_gorusu] & [tesisler]![tamamlama_tarihi] & " & _
" [tesisler]![durum],"")<> " & _
" nz([TmpTablo]![Kaynak] & [TmpTablo]![Tarih] & [TmpTablo]![Tesis] & [TmpTablo]![Yer/Bölüm] & " & _
" [TmpTablo]![Tespit Yapan] & [TmpTablo]![Uygunsuzluk/Ramak Kala/Gözlem] & " & _
" [TmpTablo]![Önerilen Aksiyon] & [TmpTablo]![Sorumlu] & [TmpTablo]![Termin Tarihi] & " & _
" [TmpTablo]![Sorumlu Görüşü/Kararı] & [TmpTablo]![Tamamlama Tarihi] & [TmpTablo]![Durum],""))) )));"
Call AlVeGuncelle(SadeceGuncelle, "", 2)
End Sub
Sub AlVeGuncelle(sqlll As String, sql2 As String, kac As Byte)
'Dosya ac -------------------------------------------------------------------------------------------------------
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False
.Title = "Lütfen Aktaraca?ynyz Bilgilerin Bulundu?u Excel Dosyasyny Seçin"
.InitialFileName = CurrentProject.Path
.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
'Dosya ac sonu -------------------------------------------------------------------------------------------------------
BasZmn = Now
'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
TestBil = ""
DoCmd.TransferSpreadsheet TransferType:=acLink, _
TableName:="TmpTablo", _
SpreadsheetType:=10, _
FileName:=yahya, _
HasfieldNames:=True, _
Range:="Sayfa1$B2:N" '"Hy bin 2!B3:E"
'hy Tablo Boş Mu_____________
SaySql = "select * from TmpTablo"
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
SaySql = " SELECT Count([TmpTablo]![KOD]) AS GnclSay " & _
" FROM TmpTablo INNER JOIN tesisler ON TmpTablo.KOD = tesisler.kod " & _
" WHERE ((([tesisler]![kaynak] & [tesisler]![tarih] & [tesisler]![tesis] & [tesisler]![bolum] & " & _
" [tesisler]![tespit_eden] & [tesisler]![gozlem] & [tesisler]![oneriler] & [tesisler]![sorumlu] & " & _
" [tesisler]![termin_tarihi] & [tesisler]![sorumlu_gorusu] & [tesisler]![tamamlama_tarihi] & " & _
" [tesisler]![durum])<>([TmpTablo]![Kaynak] & [TmpTablo]![Tarih] & [TmpTablo]![Tesis] & " & _
" [TmpTablo]![Yer/Bölüm] & [TmpTablo]![Tespit Yapan] & [TmpTablo]![Uygunsuzluk/Ramak Kala/Gözlem] & " & _
" [TmpTablo]![Önerilen Aksiyon] & [TmpTablo]![Sorumlu] & [TmpTablo]![Termin Tarihi] & " & _
" [TmpTablo]![Sorumlu Görüşü/Kararı] & [TmpTablo]![Tamamlama Tarihi] & [TmpTablo]![Durum])));"
SayRS.Open SaySql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
GuncellenecekKyt = SayRS(0)
SayRS.Close
If kac = 1 Then
CurrentDb.Execute "Delete * from tesisler"
CurrentDb.Execute sqlll
ElseIf kac = 2 Then
CurrentDb.Execute sqlll
ElseIf kac = 3 Then
CurrentDb.Execute sqlll
CurrentDb.Execute sql2
End If
SaySql = " SELECT Count(TmpTablo.KOD) AS SayKOD " & _
" FROM tesisler RIGHT JOIN TmpTablo ON tesisler.kod = TmpTablo.KOD " & _
" GROUP BY tesisler.kod " & _
" HAVING (((Count(TmpTablo.KOD)) Is Not Null) AND ((tesisler.kod) Is Null))"
SayRS.Open SaySql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
EklenecekKyt = SayRS(0)
SayRS.Close
Me.tesisler.Requery
CurrentDb.TableDefs.Refresh
DoCmd.DeleteObject acTable, "TmpTablo"
BitZmn = Now
TSaniye = DateDiff("s", BasZmn, BitZmn)
LngSn = TSaniye Mod 60
LngDk = (TSaniye \ 60) Mod 60
LngSt = (TSaniye \ 3600) Mod 60
Me.TestBil = "Yöntem : 4 " & vbCrLf & _
"Transfer bitti " & vbCrLf & _
"Güncellenen Kayıt Sayısı : " & GuncellenecekKyt & vbCrLf & _
"Eklenen Kayıt Sayısı : " & EklenecekKyt & vbCrLf & _
"Toplam Kayıt Sayısı : " & DCount("*", "tesisler") & vbCrLf & _
"Başlama Zamanı : " & Format(BasZmn, "hh:nn:ss") & vbCrLf & _
"Bitiş Zamanı : " & Format(BitZmn, "hh:nn:ss") & vbCrLf & _
"Geçen Süre : " & LngSt & ":" & _
LngDk & ":" & _
LngSn & " ( " & TSaniye & "sn )"
MsgBox "bitti"
End Sub