Bu da 2. bir yöntem --> referanslara Ado 2.8 eklenmiştir
'hy_Geçici_tablo_var_mı_varsa_sil_____
If DCount("*", "MSysObjects", "Name='TmpTablo' and type in (1,4,6)") > 0 Then DoCmd.DeleteObject acTable, "TmpTablo"
DoCmd.TransferSpreadsheet TransferType:=acLink, _
TableName:="TmpTablo", _
SpreadsheetType:=10, _
FileName:=CurrentProject.Path & "\donemoncesi.XLSX", _
HasfieldNames:=True, _
Range:="Sheet1$"
'hy Tablo Boş Mu_____________
Dim SayRS As New ADODB.Recordset
Dim SaySql As String
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 * from Sheet1"
SayRS.Open SaySql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
SqlSheet1 = " INSERT INTO Sheet1 ( "
krt = ""
For x = 0 To SayRS.Fields.Count - 1
krt = krt & " , [" & SayRS.Fields.Item(x).Name & "]"
Next x
SqlSheet1 = SqlSheet1 & Mid(krt, 3) & ")"
SayRS.Close
'hy_Sheet1_tbl______________________________||
SaySql = "select * from TmpTablo"
SayRS.Open SaySql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
SqlTmp = " select "
krt = ""
For x = 0 To SayRS.Fields.Count - 1
krt = krt & " , TmpTablo.[" & SayRS.Fields.Item(x).Name & "]"
Next x
SqlTmp = SqlTmp & Mid(krt, 3)
SayRS.Close
'hy_TmpTablo_tbl______________________________||
SqlEkle = SqlSheet1 & vbCrLf & SqlTmp & vbCrLf & " FROM TmpTablo "
CurrentDb.Execute SqlEkle
CurrentDb.TableDefs.Refresh
DoCmd.DeleteObject acTable, "TmpTablo"
crystal_hy.rar
(Dosya Boyutu: 31,26 KB | İndirme Sayısı: 4)