AccessTr.neT

Tam Versiyon: Excel Den Hücre Verisi Alma ?
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
(19/01/2020, 15:20)berduş yazdı: [ -> ]
(19/01/2020, 15:03)Myalim yazdı: [ -> ]Tek sorunumuz sıfırdan oluşan veri yüklü Excel
sıfırdan nasıl oluşturuyorsunuz?
ben de mesela sıfırdan dosya oluşturup veri ekleyip kapattım Access sorunsuz aldı
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
Kod yazmıştım belki lazım olur Img-grin


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 olur Img-grin


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
Hocam bu da çok makbule geçti çok çok teşekkür ederim
@feraz hocamınkine alternatif olarak)

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
(19/01/2020, 16:06)berduş yazdı: [ -> ]üstteki mesajı tekrar düzenledim
yanlış kod yapıştırmışım
tamamdır hocam deniyorum
mesajı tekrar güncelledim yarım yapıştırmışım kusura bakmayın
Sayfalar: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15