Run-time error '-214721 hatası

[feridici_genc]

Hayırlı günler.
Aşağıda görülen resimde ki hatayı nasıl giderebilirim
Kodun bu satırında hata veriyor.

rs.Open sorgu, con, 1, 3

 

[ÖmerBey]

Aşağıdaki linklerde de aynı hatalar alınmış ve çözüme yönelik öneriler var, inceleyiniz.
Kapalı Dosyadan Veri Almak
Kapalı dosyalara veri aktarma makrosu

 

[feridici_genc]

Sayın mutic77 bu bahsettiğiniz konulara baktım. ama anlamadığım bir şekilde hata veriyor. Bazı sitelerde çift tırnaktan önce tek tırnak yazarak deneyin filan diyorlar. Denedim maalesef olmadı. Yardımlarınızı bekliyorum.

Private Sub CommandButton2_Click()
Set con = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
    Set fso = CreateObject("Scripting.FileSystemObject")
    yol = ThisWorkbook.Path & "\ARAÇLAR"
    Range("A2:M65536").Clear
    For Each dosya In fso.getfolder(yol).Files
        If dosya.Name <> ThisWorkbook.Name And Mid(dosya.Name, 2, 1) <> "$" Then
           con.Open "provider=microsoft.ace.oledb.12.0;data source=" & dosya & ";extended properties=""Excel 12.0; hdr=yes"""
           sorgu = "SELECT PLAKA, DEPARTMAN,[ÇIKIŞ TARİHİ],[DÖNÜŞ TARİHİ],[KATEDİLEN KM] FROM [Sayfa1$]"
           rs.Open sorgu, con, 1, 3
           Range("A65536").End(3)(2, 1).CopyFromRecordset rs
           rs.Close
        End If
    Next dosya
End Sub

 

[ÖmerBey]

Yazdığınız kodu olduğu gibi denedim, çalıştı.
Problemin nereden kaynaklandığı bilemiyorum, dosya yapınızla ilgili olabilir.

 

[feridici_genc]

Sayın mucit77,
Rica etsem aşağıdaki adreste bulunan dosyalar üzerinde dener misiniz? Denemek istemezseniz aşağıdaki adreste bulunan sorunuma bir çözüm önerisi sunabilirmisiniz?

http://www.excel.web.tr/f48/dosyalaryn-belirli-sutunlaryny-ba-ka-dosyada-toplama-t153412.html

 

[Orion1]

Kaynak dosyalardaki ilgili sütun başlıklarını alt enter ile ayırmayın. sütun başlıkları düz olsun.kod aşağıdadır.

Set con = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
    Set fso = CreateObject("Scripting.FileSystemObject")
    yol = ThisWorkbook.Path & "\ARAÇLAR"
    Range("A2:M65536").Clear
    For Each dosya In fso.getfolder(yol).Files
        If dosya.Name <> ThisWorkbook.Name And Mid(dosya.Name, 2, 1) <> "$" Then
           con.Open "provider=microsoft.ace.oledb.12.0;data source=" & dosya & ";extended properties=""Excel 12.0; hdr=yes"""
           sorgu = "SELECT PLAKA, DEPARTMAN,[ÇIKIŞ TARİHİ],[DÖNÜŞ TARİHİ],[KATEDİLEN KM] FROM [Sayfa1$B3:M" & Rows.Count & "]"
           rs.Open sorgu, con, 1, 3
           Range("A65536").End(3)(2, 1).CopyFromRecordset rs
           rs.Close
        End If
        con.close
    Next dosya

 

[feridici_genc]

Özür dilerim ama bir mallık var bende sanırım.
o kodları modüle ekledim olmadı command butona ekledim yine olmadı yine aynı hatayı alıyorum.

rs.Open sorgu, con, 1, 3

satırı sarıya boyanıyor. Delircem yemin ederim.

 

[Orion1]

Kaynak dosyalardaki ilgili sütun başlıklarını alt enter ile ayırmayın. sütun başlıkları düz olsun.

Özür dilerim ama bir mallık var bende sanırım.
o kodları modüle ekledim olmadı command butona ekledim yine olmadı yine aynı hatayı alıyorum.

rs.Open sorgu, con, 1, 3

satırı sarıya boyanıyor. Delircem yemin ederim.

yukarıda bahsettim.Sanırım okumamışsınız!

 

[feridici_genc]

Bir eklentiyimi aktif etmem gerekiyor anladım ya.

 

[feridici_genc]

Sayın Orion1 bütün birleştirilmiş hücreleri çözdüm. alt enter ile ayrılanları eski haline döndürdüm. yine aynı hata yine aynı hata. bence bir eklenti aktif edilecek ama hangisi?

 

[Orion1]

Bir eklentiyimi aktif etmem gerekiyor anladım ya.

eklenti aktif etmeyeceksiniz.Sadece kaynak dosyalarda alt+enterle girdiğiniz sütun başlıklarını düzleştireceksiniz

 

[feridici_genc]

kusura bakmayın. özür dilerim. şuan oldu. elinize sağlık

 

[Orion1]

kusura bakmayın. özür dilerim. şuan oldu. elinize sağlık

Rica ederim.
İyi çalışmalar.

 

[feridici_genc]

Sayın Orion1
Bu kodlar şöyle değiştirebilir miyiz?
Sadece sayı ile başlayan dosyalardan bilgi alsa..
Çünkü aynı klasörde başka dosyalar da var.

 

[feridici_genc]

Yani dosya ismi sayı ile başlayanlardan.
Açıklama eksik olmuş.

 

[Orion1]

Sayın Orion1
Bu kodlar şöyle değiştirebilir miyiz?
Sadece sayı ile başlayan dosyalardan bilgi alsa..
Çünkü aynı klasörde başka dosyalar da var.

İlgili satırı aşağıdaki kod ile değiştirip deneyiniz.

 If dosya.Name <> ThisWorkbook.Name And Mid(dosya.Name, 2, 1) <> "$" _
                And IsNumeric(Left(dosya.Name, 1)) Then

 

[feridici_genc]

Üstad ilgin için teşekkür ederim. Bunu deneyeceğim bir sıkıntı daha oluştu..
Ayıp olmazsa ona da yardım edebilirmisin?
ilgili kodda nasıl bir değişiklik yapmamız gerekiyor ki "C:\Users\ocop0909\Desktop\araçlar" klasöründen veri alsın? aynı klasör içindeki /araçlar klasöründe bir sıkıntı yok yalnız ben bunu ağda kullanacağım. Dosya yolu ile ilgili kodu düzenleyemedim.

 

[Orion1]

Üstad ilgin için teşekkür ederim. Bunu deneyeceğim bir sıkıntı daha oluştu..
Ayıp olmazsa ona da yardım edebilirmisin?
ilgili kodda nasıl bir değişiklik yapmamız gerekiyor ki "C:\Users\ocop0909\Desktop\araçlar" klasöründen veri alsın? aynı klasör içindeki /araçlar klasöründe bir sıkıntı yok yalnız ben bunu ağda kullanacağım. Dosya yolu ile ilgili kodu düzenleyemedim.

İlgili kodu değiştirin.

yol = "C:\Users\ocop0909\Desktop\araçlar"

 

[feridici_genc]

Allah razı olsun. Teşekkürler.

 

[Orion1]

Allah razı olsun. Teşekkürler.

Rica ederim.
İyi çalışmalar.