Kapalı excelden veri çekme hk.

[valentino06]

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

 

[valentino06]

Arkadaşlar lütfen yardımcı olabilir misiniz. çok teşekkür ederim.

 

[Korhan Ayhan]

Deneyin bakalım sizde çalışacak mı?

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

 

[valentino06]

Sayın@Korhan Ayhan Hocam aşağıdaki hatayı alıyorum.

 

[valentino06]

 

[Korhan Ayhan]

Forumda paylaştığınız dosyalarda mı denediniz?

 

[valentino06]

evet Korhan Ayhan Hocam forumda paylaştığım dosyada denedim.

 

[Haluk]

@Korhan Ayhan ;

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

    '......
    '....
    '..
    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
   
    '.....
    '....
    '..

.

.

 

[valentino06]

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

 

[Haluk]

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.

.

 

[valentino06]

Haluk Hocam aynı hatayı veriyor. Hocam orjinal dosyaya hiç uyarlamadım. Örnekte denedim olmadı.

 

[Haluk]

Dosyalar bu şekilde mi?

Örnek\Data.xlsb

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

.

 

[valentino06]

Haluk Hocam aynen yazdığınız gibi verilerin yolları orjinal de hiç denemedim.

 

[Haluk]

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.


.

 

[valentino06]

ş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]

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

Ekli dosyayı görüntüle 219073

Ekli dosyayı görüntüle 219074

Deneyiniz

 

[valentino06]

@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]

@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

 

[Haluk]

ş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...

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

.

 

[Korhan Ayhan]

@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.