Kapalı Dosyadan Veri Aktarma

[Nightwolf_03]

Arkadaşlar selam ,

kapalı bir excel dosyasından calışma yaptığım bir dosyaya veri aktarımı yapmaya ihtiyacım var. Forumda bazı örnekler buldum fakat istediğim gibi bir örnek bulamadım yada uyarlayamadım

benim data_veri dosyam farklı bir klasörde , calısma_kitabı dosyam farklı bir klasörde aynı klasörlerde değil yani.

konu ile ilgili yardımlarınızı rica ediyorum.

 

[Emir Hüseyin Çoban]

. . .

Sub KOD()
    
    
    yol = "C:\Users\Hüseyin\Desktop\deneme\DATA_VERİ.xlsx"
    
    Dim con As Object:  Set con = CreateObject("adodb.connection")
    Dim rs As Object:   Set rs = CreateObject("adodb.recordset")
    
    con.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
    yol & ";Extended Properties=""Excel 12.0;HDR=Yes"""
   
    sorgu = "select * from [data$A:D]"
    rs.Open sorgu, con, 3, 1
               
    If rs.RecordCount > 0 Then
    Range("A2:D" & Rows.Count).ClearContents
    Range("A2").CopyFromRecordset rs
    End If
    
    rs.Close
    
    
    Set con = Nothing: Set rs = Nothing: sorgu = Empty
End Sub

. . .

 

[Nightwolf_03]

ilginiz için tşk ederim Emir Hüseyin Çoban .

ancak ;

Sub KOD()


yol = "C:\Users\burak.tunceri\Documents\ÇALIŞMA DOSYASI\BÜTÇE ÇALIŞMA\2016 BÜTÇE\DATA_VERİ.xlsx"

Dim con As Object: Set con = CreateObject("adodb.connection")
Dim rs As Object: Set rs = CreateObject("adodb.recordset")

con.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
yol & ";Extended Properties=""Excel 12.0;HDR=Yes"""

sorgu = "select * from [data$A]"
rs.Open sorgu, con, 3, 1

If rs.RecordCount > 0 Then
Range("A2" & Rows.Count).ClearContents
Range("A2").CopyFromRecordset rs
End If

rs.Close


Set con = Nothing: Set rs = Nothing: sorgu = Empty
End Sub


kodun kırmızı ile boyadığım bölümde hata aldım yardımcı olabilirmisiniz

 

[Emir Hüseyin Çoban]

. . .

Kullandığınız excel office versiyonu nedir.

. . .

 

[Nightwolf_03]

excel 2013

 

[Emir Hüseyin Çoban]

. . .

Aldığınız hatanın ekran görüntüsünü yükleyin. İnceleyelim.

. . .

 

[Nightwolf_03]

Ekte görebilirsiniz Emir Hüseyin bey

 

[Emir Hüseyin Çoban]

. . .

El yordamıyla bir işlem yapmamız gerekiyor. Kodlardaki 12 kısmını 10 dan başlayıp 16 ya kadar değiştirerek deneyiniz.

    con.Open "Provider=Microsoft.Ace.Oledb.[B][COLOR="Red"]12[/COLOR][/B].0;Data Source=" & _
    yol & ";Extended Properties=""Excel [COLOR="Red"][B]12[/B][/COLOR].0;HDR=Yes"""

. . .

 

[Nightwolf_03]

Maalesef olmadı yanlız 15 yaptığımda hata nın türü değişti.

 

[Orion1]

Yol'u yanlış girmiş olmayasınız!

 

[Nightwolf_03]

yol doğru üstadım.

 

[Orion1]

yol doğru üstadım.

O zaman her 2 dosyayıda ayni klasöre koyup deneyin.
Ben denedim çalıştı.
Eğer çalışıyorsa yol da hata var demektir.

Sub KOD()
    
    
    [B][COLOR="Red"]yol = ThisWorkbook.Path & "\DATA_VERİ.xlsx"[/COLOR][/B]
    
    Dim con As Object:  Set con = CreateObject("adodb.connection")
    Dim rs As Object:   Set rs = CreateObject("adodb.recordset")
    
    con.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
    yol & ";Extended Properties=""Excel 12.0;HDR=Yes"""
   
    sorgu = "select * from [data$A:D]"
    rs.Open sorgu, con, 3, 1
               
    If rs.RecordCount > 0 Then
    Range("A2:D" & Rows.Count).ClearContents
    Range("A2").CopyFromRecordset rs
    End If
    
    rs.Close
    
    
    Set con = Nothing: Set rs = Nothing: sorgu = Empty
End Sub

 

[Nightwolf_03]

üstadım sıkıntım o zaten aynı klasörde olsa çözümleri sitede mevcut
dosyalar farklı klasörlerde olmalı aynı klasörde olmamalı

 

[Orion1]

üstadım sıkıntım o zaten aynı klasörde olsa çözümleri sitede mevcut
dosyalar farklı klasörlerde olmalı aynı klasörde olmamalı

Ayni klasörde çalışıyorsa farklı klasörde çalışmıyorsa yol'da hata var demektir.

 

[Orion1]

Aşağıdaki yoldaki stringte nokta var.
Klasörünüzdeki noktayı temizleyip öyle yazıp deneyiniz.

yol = "C:\Users\[B][COLOR="Red"]burak.tunceri[/COLOR][/B]\Documents\ÇALIŞMA DOSYASI\BÜTÇE ÇALIŞMA\2016 BÜTÇE\DATA_VERİ.xlsx"

 

[Nightwolf_03]

kırmızı ile olan bölümü değiştirme şansım yok bilgisayarın kullanıcı ismi o bölüm ...

 

[Nightwolf_03]

birde ben bunu excel 2010 versiyonu olan başka bir bilgisayarda denedim kod çalıştı ... ancak bu kod 2013 excel de çalışmıyor anladığım kadarıyla

 

[Korhan Ayhan]

Aşağıdaki sitede örnek bağlanma kodları var. Sisteminize uygun olanı deneyiniz.

https://www.connectionstrings.com/excel-2013/