[ÇÖZÜLDÜ] Ado ile Kapalı Dosyadan Sayfa Kopyalama

cenderus · 12 Ekim 2008

Değerli arkadaşlar;

levent hocam daha once sorunumla ilgili aşağıdaki kodu benimle paylaştı kendisine burdan tekrar teşekkur ederim kod foruma gonderdiğim ornek dosya içinde mukemmel bir şekilde çalışıyordu hatta dosya içine benzer veriler girip defalarca denedim ve çalıştı fakat kodu basit bir şekilde kendime revize ettiğimde hata vermeye başladı

orjinal kod buydu

Kod:

Sub verilerial()
dosyaadi = Array("dat1", "dat2", "dat3")
Set baglanti = CreateObject("ADODB.Connection")
Set sayfalar = CreateObject("ADOX.Catalog")
For a = 0 To UBound(dosyaadi)
baglanti.Open "Driver={Microsoft Excel Driver (*.xls)};Dbq=E:\sample\" & dosyaadi(a)
sayfalar.ActiveConnection = baglanti
For Each sayfa In sayfalar.Tables
sayfaadi = Replace(Left(sayfa.Name, Len(sayfa.Name) - 2), "'", "")
Set rs = baglanti.Execute("[" & sayfaadi & "$a28:fd3000]")
Sheets(sayfaadi).[a29].CopyFromRecordset rs
Next
rs.Close
baglanti.Close
Next
End Sub

oysa kod uzerinde yaptığım ilk değişilik dosya veri yolunu değişmekti ve

E:\sample\ yerine D:\sample\ yaptım ve

Kod:

Sub verilerial()
dosyaadi = Array("dat1", "dat2", "dat3")
Set baglanti = CreateObject("ADODB.Connection")
Set sayfalar = CreateObject("ADOX.Catalog")
For a = 0 To UBound(dosyaadi)
baglanti.Open "Driver={Microsoft Excel Driver (*.xls)};Dbq=D:\sample\" & dosyaadi(a)
sayfalar.ActiveConnection = baglanti
For Each sayfa In sayfalar.Tables
sayfaadi = Replace(Left(sayfa.Name, Len(sayfa.Name) - 2), "'", "")
Set rs = baglanti.Execute("[" & sayfaadi & "$a28:fd3000]")
Sheets(sayfaadi).[a29].CopyFromRecordset rs
Next
rs.Close
baglanti.Close
Next
End Sub

ama aşağıdaki hatayı verdi

Run-time error'-2147217900 (80040e14)':
[Microsoft][ODBC Excel Driver] Invalid SQL statement;expected
'DELETE','INSERT','PROCEDURE','SELECT',or'UPDATE'.

ve

bu satırda takılıyor

Set rs = baglanti.Execute("[" & sayfaadi & "$a28:fd3000]")

bu seferde kodu

Kod:

Sub verilerial()
dosyaadi = Array("1", "2", "3")
Set baglanti = CreateObject("ADODB.Connection")
Set sayfalar = CreateObject("ADOX.Catalog")
For a = 0 To UBound(dosyaadi)
baglanti.Open "Driver={Microsoft Excel Driver (*.xls)};Dbq=D:\sample\" & dosyaadi(a)
sayfalar.ActiveConnection = baglanti
For Each sayfa In sayfalar.Tables
sayfaadi = Replace(Left(sayfa.Name, Len(sayfa.Name) - 2), "'", "")
Set rs = baglanti.Execute("[" & sayfaadi & "$a28:fd3000]")
Sheets(sayfaadi).[a29].CopyFromRecordset rs
Next
rs.Close
baglanti.Close
Next
End Sub

şeklinde dosya adı ile değiştirince

bu seferde

rs.Close

kısmında takıldı

anlayamadıgım iki hatanında birbirinden bağımsız hatalar oldugunu tahmin ediyorum yani kodu incelediğimde yaptığım değişikliklerin etkili olduğunu düşünmüyorum sizce sorun nerde olabilir arkadaşlar

dosyalarda yapmış oldugum tek veri değişiklik

dat dosyalarının içine metin ve sayısal veri girmek ki veri aralığı ve format birebir ornek dosyam ile aynı;

Levent Menteşoğlu · 12 Ekim 2008

Hata, büyük ihtimalle sayfa adlarından kaynaklanıyor. Gerçek dosyanızın bir örneğini eklemenizi öneririm.

cenderus · 13 Ekim 2008

hocam,

Değerli hocam size gonderdiğim ornekta sayfa isimleri 1a,2b,3c şeklindeydi orjinalinde ise

asagidaki gibi , sizce sorun burdamı yani 2 karakter yerine 5 ve üzeri karakter yüzündenmi takılıyordur ;

Trabzon1
Trabzon2
Rize1
Rize2
Giresun1
Giresun2
Samsun1
Samsun2
Erzurum1
Erzurum2
Sivas1
Sivas2
Antalya1
Antalya2
Gaziantep1
Gaziantep2
Sanlıurfa1
Sanlıurfa2
Osmaniye1
Osmaniye2
Seyhan1
Seyhan2
Ceyhan1
Ceyhan2
Kayseri1
Kayseri2
Konya1
Konya2
Eskisehir1
Eskisehir2
Ankara1
Ankara2
Cankırı1
Cankırı2
Kırıkkale1
Kırıkkale2
Izmir1
Izmir2
Bursa1
Bursa2
Balıkesir1
Balıkesir2
Adapazarı1
Adapazarı2
Tekirdag1
Tekirdag2

Levent Menteşoğlu · 13 Ekim 2008

Kod içindeki aşağıdaki satırda bulunan 2 rakamını 1 yapın.

Kod:

sayfaadi = Replace(Left(sayfa.Name, Len(sayfa.Name) - [B][COLOR=red]2[/COLOR][/B]), "'", "")

cenderus · 13 Ekim 2008

hocam tekrar teşekkurler

hocam tekrar tesekkur ederim işlem yapıyor kopyalamanın sonuna doğru aynı hatayı veriyor ama sanırım bunun nedeni ana dosyada diğer dosylarda yer almayan analiz ve grafik diye fazladan 2 sayfa daha olması.

Bu dogrumudur hocam yani kod birebir kopyladıgında açık olan ana dosyada fazla bir yada iki sayfaya kapalı dosyada eş bulamayınca hata veriyor olabilirmi ?

hocam orjial dosya boyutu sadece format halinde 33mb rarla bile forum limitini aşıyor

Levent Menteşoğlu · 13 Ekim 2008

Evet bulamayınca hata verir.

cenderus · 13 Ekim 2008

hocam teşekkurler

hocam teşekurler izninizle ustunde biraz çalışmak istiyorum belki kodun bu halini bozmadan kapalı dosya sayfalarında bir değşiklikle olayı aşabilirim bu arada hocam bir sorum var ama cevabını tahmin ediyorum kodunuz 3 sayfa üstüne kurulu ama bunu 4 yada 5 dosyaya çıkarmak istediğimde sadece ağşağıdaki satırı değişmem yeterlimi ?

3 dosya
dosyaadi = Array("dat1", "dat2", "dat3")

4 dosya
dosyaadi = Array("dat1", "dat2", "dat3", "dat4")

5 dosya

dosyaadi = Array("dat1", "dat2", "dat3", "dat4", "dat5")

Levent Menteşoğlu · 13 Ekim 2008

cenderus' Alıntı:
hocam teşekurler izninizle ustunde biraz çalışmak istiyorum belki kodun bu halini bozmadan kapalı dosya sayfalarında bir değşiklikle olayı aşabilirim bu arada hocam bir sorum var ama cevabını tahmin ediyorum kodunuz 3 sayfa üstüne kurulu ama bunu 4 yada 5 dosyaya çıkarmak istediğimde sadece ağşağıdaki satırı değişmem yeterlimi ?
.....

Evet yeterlidir.

mrwarrior · 13 Kasım 2020

Çok eski bir konu. Yenisini bulamadım. Hortlatmak gibi ama.

Kapalı bir dosyam var. Excel ile bundaki "Sonuçlar"sekmesini kendi dosyamda sona kopyalamak istiyorum.

Bunun için nasıl yazmam gerek.

Korhan Ayhan · 13 Kasım 2020

Sayfayı değilde içindeki veriyi kendi dosyanıza aktarabilirsiniz.

Dosya yolunu-adını ve verilerin aktarılacağı sayfa adını kendinize göre düzenleyip kullanabilirsiniz.

C++:

Option Explicit

Sub Verileri_Aktar()
    Dim Yol As String, Dosya As Variant, S1 As Worksheet, Zaman As Double
    Dim Baglanti As Object, Sorgu As String, Kayit_Seti As Object
     
    Zaman = Timer
 
    Application.ScreenUpdating = False
 
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
    Set S1 = Sheets("Verilerin_Aktarılacağı_Sayfa")
     
    S1.Cells.Clear
   
    Yol = ThisWorkbook.Path & Application.PathSeparator
   
    Dosya = Yol & "Veri Alınacak Dosya Adı.xlsx"
   
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
       
    Sorgu = "Select * From [Sonuçlar$]"
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
       
    If Kayit_Seti.RecordCount > 0 Then
        S1.Range("A1").CopyFromRecordset Kayit_Seti
        S1.Columns.AutoFit
        Application.ScreenUpdating = True
        MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Aktarılacak veri bulunumadı!", vbCritical
    End If
   
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
   
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    Set S1 = Nothing
End Sub

mrwarrior · 13 Kasım 2020

Teşekkürler ilginiz için. Ben veri kopyalamaya bakmıştım da tüm sayfayı bütün olarak almak istiyordum. Çünkü orada düzenlemelerde hazır. O zaman önce bir taslak oluşturup sonra verileri çekip yapmak daha mantıklı anladığım kadarı ile?

Korhan Ayhan · 13 Kasım 2020

Siz talebinizi kapalı dosya ve ADO konusuna yazınca talebinizin bu yönde olduğunu düşündüm.

Amaç dosyadan sayfa almak ise ilgili dosya açılıp sayfa kopyalama-taşıma yapılabilir.

mrwarrior · 6 Aralık 2020

Hocam ihtiyacım olanı anladım. Dediğiniz gibi sayfa açıp göndermek benim için daha avantajlı. Şimdi bunu inceleyeceğim. Biraz geç oldu teşekkür. ADO yu çok istedim. Çok daha hızlı idi. Ama nasip değilmiş. Benim istediğime de uymadı.

mrwarrior · 9 Aralık 2020

Hocam ADO mükemmel çalıştı. Tam istediğim gibi ayarlayabildim. Normalde 1 veri almak için 10 15 sn ye geçerken şimdi 0.8 sn ye gibi bir sürede 3 tane veri alıyorum .

Şimdi başka bir veri alma işlemi daha var. Ancak bu dosya csv dosyası. Acaba Csv den veri alırken kodlar farklı mı?. Benim istediğim veriyi olduğu gibi xlsm dosyası gibi virgülle ayrılmış bir şekilde almak. ve A2 hücresine alt alta gelecek şekilde koymak. Ama

Kod:

Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""

kısmında hata verdi. Bir de

Korhan Ayhan · 9 Aralık 2020

Linkleri inceleyiniz.

Kapalı CSV Dosyasından Veri Çekmek

Aynen hocam. Örnek var ikinci mesajda. Xls dosyaları var. Onları alıp ana klasörde sayfa1 de a2 den başlayarak yaoıltıracak. Dosyanız aşağıdaki linkte mevcuttur. DOSYA İNDİR Sub csvaktar59V3() Dim dosya, conn As Object, rs As Object, sat As Long Dim ds, f, dsy As String, a As String ChDir...

www.excel.web.tr

64 bit excel ADO csv dosyasına bağlantı

Merhaba, 64 bit office 2013 yüklü sistemde csv dosyalarına hangi bağlantı yolu ile ulaşabilirim. Aşağıdaki yol ile olmadı.Yardımcı olabilir misiniz. Set con = VBA.CreateObject("Adodb.Connection") con.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & _ yol &...

www.excel.web.tr

tahsinanarat · 2 Ocak 2021

Kod:

Option Explicit

Sub Verileri_Aktar()
    Dim Yol As String, Dosya As Variant, S1 As Worksheet, Zaman As Double
    Dim Baglanti As Object, Sorgu As String, Kayit_Seti As Object
'     On Error Resume Next
    Zaman = Timer

    Application.ScreenUpdating = False

    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
    Set S1 = Sheets("Sayfa1")

    S1.Cells.Clear

'    Yol = ThisWorkbook.Path & Application.PathSeparator
    Yol = "C:\PERSONEL\"

    Dosya = Yol & "PERSONEL_2020.xlsm"

    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""

'    Sorgu = "Select * From  [PERSONEL$A2:AL65000]"
    Sorgu = "Select * From  [PERSONEL$A2:AL65000]"
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1

    If Kayit_Seti.RecordCount > 0 Then
        S1.Range("A1").CopyFromRecordset Kayit_Seti
        S1.Columns.AutoFit
        Application.ScreenUpdating = True
        MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Aktarılacak veri bulunumadı!", vbCritical
    End If

    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close

    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    Set S1 = Nothing
End Sub


https://www.excel.web.tr/threads/coezueldue-ado-ile-kapali-dosyadan-sayfa-kopyalama.57380/

Sn. @Korhan Ayhan hocam, bu kodunuz ile kapalı dosyadan veril alabiliyorum.
Bazı (Tarih, sicil, Tc Kimlik) vs. gibi sutun başlıklarını almıyor, sutun başlığının tamamını alabilmek için kodda nasıl bir revize yapmalıyız. Teşekkürler.

Korhan Ayhan · 2 Ocak 2021

Linki inceleyiniz.

Soru - Kapalı dosyayı açmadan veri çekmek

Merhaba, öncelikle mevcut örnekleri inceledim ancak kodların çoğu karışık geldiğinden uyarlamada sıkıntı yaşadım. bazı eski örnek dosyalarda sitede artık bulunmadığından sonuca ulaşamadım. referans olması açısında tekrar konu açtım. Ornek1 dosyasına, Ornek2 dosyasında veri aktarmak istiyorum...

www.excel.web.tr

Linkteki bu bölüm başlıkları alıyor.

C++:

    For X = 0 To Kayit_Seti.Fields.Count - 1
       S1.Cells(1, X + 1) = Kayit_Seti.Fields(X).Name
    Next

[ÇÖZÜLDÜ] Ado ile Kapalı Dosyadan Sayfa Kopyalama

cenderus

Levent Menteşoğlu

Administrator

cenderus

Levent Menteşoğlu

Administrator

cenderus

Levent Menteşoğlu

Administrator

cenderus

Levent Menteşoğlu

Administrator

mrwarrior

Korhan Ayhan

Administrator

mrwarrior

Korhan Ayhan

Administrator

mrwarrior

mrwarrior

Korhan Ayhan

Administrator

Kapalı CSV Dosyasından Veri Çekmek

64 bit excel ADO csv dosyasına bağlantı

tahsinanarat

Korhan Ayhan

Administrator

Soru - Kapalı dosyayı açmadan veri çekmek