(19/01/2020, 15:20)berduş yazdı:Aslında hocam çözdüm sayılır form açıldığında olay yordamına Bilgiler. Xls açacak bir kod yazdım dolayısıyla çözüldü diyebiliriz. Son kez cevaplanmışlara taşıyabiliriz, her şey için çok çok teşekkürlwr(19/01/2020, 15:03)Myalim yazdı: Tek sorunumuz sıfırdan oluşan veri yüklü Excelsıfırdan nasıl oluşturuyorsunuz?
ben de mesela sıfırdan dosya oluşturup veri ekleyip kapattım Access sorunsuz aldı
Excel Den Hücre Verisi Alma ?
Kod yazmıştım belki lazım olur
Private Sub Komut0_Click()
Call excelAcKapat
' myWorkbook.Close False buradaki tek tırnak kalkarsa kapanır excel
Private Sub Komut0_Click()
Call excelAcKapat
' myWorkbook.Close False buradaki tek tırnak kalkarsa kapanır excel
Kod:
Option Compare Database
Sub excelAcKapat()
Dim yol As String
Dim appExcel As Object
Dim myWorkbook As Object
yol = CurrentProject.Path & "\Bilgiler.xlsx"
Set appExcel = CreateObject("Excel.Application")
Set myWorkbook = appExcel.Workbooks.Open(yol)
appExcel.Visible = True
' myWorkbook.Close False
Set appExcel = Nothing
Set myWorkbook = Nothing
End Sub
(19/01/2020, 15:54)feraz yazdı: Kod yazmıştım belki lazım olurHocam bu da çok makbule geçti çok çok teşekkür ederim
Private Sub Komut0_Click()
Call excelAcKapat
' myWorkbook.Close False buradaki tek tırnak kalkarsa kapanır excel
Kod:Option Compare Database
Sub excelAcKapat()
Dim yol As String
Dim appExcel As Object
Dim myWorkbook As Object
yol = CurrentProject.Path & "\Bilgiler.xlsx"
Set appExcel = CreateObject("Excel.Application")
Set myWorkbook = appExcel.Workbooks.Open(yol)
appExcel.Visible = True
' myWorkbook.Close False
Set appExcel = Nothing
Set myWorkbook = Nothing
End Sub
@feraz hocamınkine alternatif olarak)
kodu aşağıdaki gibi düzenler misiniz
kodu aşağıdaki gibi düzenler misiniz
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConn As String, sConn2 As String
Dim degerler, cinsiyet, sSql, GcDgr As String
txtDosyaAdres = CurrentProject.Path & "\Bilgiler.xlsx" ' Buraya dosya adresi ve adı yazılacak
'hy Excel Acıp kapatma_____________________________________
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application") 'exceli aç
With xlApp
.Workbooks.Open (txtDosyaAdres) 'Excel dosyasını aç
.ActiveWorkbook.Close False ' kaydetmeden kapat _
eğer kaydetmesini isterseniz .ActiveWorkbook.Close TRUE yapmalısınız
If .Workbooks.Count = 0 Then .Quit ' kaç Excel dosyası açık eğer başka açık dosya yoksa Excel kapatır
End With
'hy Excel Acıp kapatma_____________________________________Bitti
degerler = ""
sSql = "select F2,F6,f15 from [Bilgiler1$] where f2 Is Not Null" '
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & txtDosyaAdres
sConn2 = ";Extended Properties=""Excel 12.0 Xml;HDR=No;Imex=1"";"
Set con = New ADODB.Connection
con.Open sConn & sConn2
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open sSql, con, adOpenKeyset 'rather use this so RecordCount works
If rs.RecordCount = 0 Then Exit Sub
rs.MoveLast
rs.MoveFirst
x = 0
Do Until rs.EOF = True
x = x + 1
cinsiyet = cinsiyet & rs.Fields(2)
GcDgr = ", '" & rs.Fields(1) & "'"
If x = 8 Then GcDgr = ", '" & CStr(CDate(rs.Fields(1))) & "'" 'doğum tarihini tarihe çevirmek için
If x = 11 Then GcDgr = "" 'NUFUSA KAYITLI OLDUĞU satırını pas geçmesi için
degerler = degerler & GcDgr
rs.MoveNext
Loop
degerler = Mid(degerler & ", '" & cinsiyet & "'", 2)
sSql = " insert into [Veriler1] (seriNo, kimlikNo, soyad, adi, babaAd, anneAd, dogumYeri, dogumTarih, medeni, durumu, nufusil, nufusilce, nufusKoyMahalle,cinsiyet) " & _
" values (" & degerler & ")"
CurrentDb.Execute sSql
Set rs = Nothing
Konuyu Okuyanlar: 2 Ziyaretçi