• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kapalı excelden veri çekme hk.

Katılım
19 Şubat 2007
Mesajlar
630
Excel Vers. ve Dili
Ofis 365 Tr- 64 Bit
Merhaba,
Değerli excel hocalarım kapalı excel kitabından veri çekmek istiyorum. lütfen yardımcı olabilirmisiniz. iş planı excel kitabındaki sarı ile boyadığım sütünlardaki verileri Data excel kitabındaki sarı ile boyadığım sütunlara getirmek istiyorum ve data sayfasında butonla güncellemek istiyorum. lütfen yardımcı olabilirmisiniz.

İşplanın'dan çekilecek sütünlar.
"A,B,E,F,H,I,J,K" Bu sütünlar çekilecek.
Data Kitabında Veri sayfasına çekilecek veriler aşağıdaki gibi olcak.

A Sütununa Kod Adı gelecek
B Sütunana Proje Adı Gelecek
G Sütünuna Açılış Tarihleri gelecek
K Sütunana Termin Tarihleri gelecek
H Sütunan Planlanan Başlıngıç Tarihleri gelecek
I Sütunu İmalat Başlama Tarihine gelecek
j Sütünuna Planlanan Bitiş Tarihi gelecek
L Sütunu Malzeme Teslim Tarihi Gelecek
 

Ekli dosyalar

Arkadaşlar lütfen yardımcı olabilir misiniz. çok teşekkür ederim.
 
Deneyin bakalım sizde çalışacak mı?

C++:
Option Explicit

Sub Verileri_Aktar()
    Dim Dosya As String, Baglanti As Object, Sorgu As String
    Dim Kayit_Seti As Object, Sayfa As Worksheet, Zaman As Double
    
    Zaman = Timer
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    
    Dosya = ThisWorkbook.Path & Application.PathSeparator & _
            "New folder" & Application.PathSeparator & "İş Planı.xlsx"
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Sorgu = "Select F1, F2 From [2020 $A3:B]"
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("A8").CopyFromRecordset Kayit_Seti
    
    Sorgu = "Select F1 From [2020 $E3:E]"
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("G8").CopyFromRecordset Kayit_Seti
    
    Sorgu = "Select F1, F2, F3 From [2020 $H3:J]"
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("H8").CopyFromRecordset Kayit_Seti
    
    Sorgu = "Select F1 From [2020 $F3:F]"
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("K8").CopyFromRecordset Kayit_Seti
    
    Sorgu = "Select F1 From [2020 $K3:K]"
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("L8").CopyFromRecordset Kayit_Seti
    
    Kayit_Seti.Close
    Baglanti.Close
    
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
Forumda paylaştığınız dosyalarda mı denediniz?
 
@Korhan Ayhan ;

Alternatif olarak, aşağıdaki gibi 1 adet sorguyla da veriler alınabilir...

Kod:
    '......
    '....
    '..
    Sorgu = "Select F1, F2,'' ,'' ,'','', F5, F8, F9, F10, F11 From [2020 $A3:K]"
   
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("A8").CopyFromRecordset Kayit_Seti
   
    Kayit_Seti.Close
    Baglanti.Close
   
    '.....
    '....
    '..

.

.
 
Haluk Hocam çok teşekkür ederim. Yukardaki hatayı veriyor. neden veriyor. anlamadım. aşağıya hatayı ekliyorum.

219073

219074
 
Data.xlsb dosyası Örnek klasörünün içindeyse ve İş Planı.xlsx dosyası da Örnek\New Folder isimli klasörün içindeyse sorun olmaması gerekir.

.
 
Haluk Hocam aynı hatayı veriyor. Hocam orjinal dosyaya hiç uyarlamadım. Örnekte denedim olmadı.
 
Dosyalar bu şekilde mi?

Örnek\Data.xlsb

Örnek\New Folder\İş Planı.xlsx

.
 
Haluk Hocam aynen yazdığınız gibi verilerin yolları orjinal de hiç denemedim.
 
Bir de Dosya adını kontrol etmenizde fayda var .....

İş Planı.xlsx >>>>> "ı" harfi mi "i" harfi mi kullanılıyor?

Planı ... Plani artık hangisi doğruysa kodlarda onu kullanın.


.
 
şimdi oldu. Haluk Hocam ve sayın Korhan Ayhan Hocam çok teşekkür ederim. Allah yolunuzu açık etsin. Hocam Orjinal dosya Data.xlsb masa üstünde olsa çalışırmı
 
@metin_0606 Hocam çok teşekkür ederim. sayın metin_0606 Hocam data.xlsb. masa üstünde olacak şekilde ayarlama olasılığınız varmı. çok teşekkür ederim.
@sayın Haluk,Korhan Ayhan Hocama vermiş oldukları destekten dolayı tekrar çok teşekkür ederim. Cümlenizden Allah Razı Olsun. Allah'a emanet olun.
Saygılarımla,
 
@metin_0606 Hocam çok teşekkür ederim. sayın metin_0606 Hocam data.xlsb. masa üstünde olacak şekilde ayarlama olasılığınız varmı. çok teşekkür ederim.
@sayın Haluk,Korhan Ayhan Hocama vermiş oldukları destekten dolayı tekrar çok teşekkür ederim. Cümlenizden Allah Razı Olsun. Allah'a emanet olun.
Saygılarımla,
Aynı klasör içinde olması gerekiyor
 
şimdi oldu. Haluk Hocam ve sayın Korhan Ayhan Hocam çok teşekkür ederim. Allah yolunuzu açık etsin. Hocam Orjinal dosya Data.xlsb masa üstünde olsa çalışırmı


  • Masaüstünde "İş Planı" adında bir klasör ve onun içinde de "İş Planı.xlsx" dosyası olması gerekir...
  • Klasör/Dosya isimlerinde "ı", "i" harflerine dikkat edin...
  • Kodların olduğu dosya, masaüstünde olacak...

Kod:
Sub Test2()
    Dim Dosya As String, Baglanti As Object, Sorgu As String
    Dim Kayit_Seti As Object, Sayfa As Worksheet, Zaman As Double
  
    Zaman = Timer
  
    Set Baglanti = CreateObject("AdoDb.Connection")
  
    Dosya = ThisWorkbook.Path & Application.PathSeparator & _
            "İş Planı" & Application.PathSeparator & "İş Planı.xlsx"
  
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""

    Sorgu = "Select F1, F2,'' ,'' ,'','', F5, F8, F9, F10, F11 From [2020 $A3:K]"
 
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("A8").CopyFromRecordset Kayit_Seti
 
    Kayit_Seti.Close
    Baglanti.Close
          
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
  
    MsgBox "Veri aktarimi tamamlanmistir." & Chr(10) & Chr(10) & _
           "Islem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub



.
 
Son düzenleme:
@Haluk Bey,

Sizin uyguladığınız yöntemle aradaki aktarım yapılmaması gereken yerlere Null kayıtlar yazıyor. Ben bu sebeple kullanmak istememiştim.

Yine de yol göstericiliğiniz için teşekkür ederim.
 
Geri
Üst