Dosyalar arasında veri çekiyorum. makroda hata aldım

vivident · 18 Nisan 2013

Merhaba

İki adet dosyam var
mg ve mg3

mg dosyasından kutucuğa tıklıyorum. mg3'ün yerini gösteriyorum. mg3'ün sayfa2'de ki değerleri mg dosyasında sayfa1'e yapıştırmak istiyorum. Ama hata aldım

Kodlarım
Sub ekle()
dosya = Application.GetOpenFilename
If dosya = False Then Exit Sub
Sheets("Sayfa1").Range("A2:C" & Rows.Count).ClearContents
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.RECORDSET")
conn.Open "Provider=microsoft.ace.oledb.12.0;data source=" & dosya & ";extended properties=""excel 12.0;hdr=yes;imex=1"";"
rs.Open "select * from [Sayfa2$] where SAYI=" & Range("a1:a3").Value & ";", conn, 1, 1
Sheets("Sayfa1").Range("A1").CopyFromRecordset rs
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
Sheets("Sayfa1").Select
MsgBox "İşlem Tamamlanmıştır." & vbLf & _
"1111", vbOKOnly + vbInformation, Application.UserName
End Sub

Şimdiden teşekkürler

vivident · 18 Nisan 2013

Yardım edebilecek bi arkadaş yokmu...!!

mancubus · 18 Nisan 2013

where SAYI=" & Range("a1:a3").Value

SAYI alanı için kriter olarak "range" mi?

vivident · 19 Nisan 2013

where yerine sayfa2'de ki tüm verileri nasıl kopyalarım
rs.Open "select * from [Sayfa2$] sonrası ne olmalı ??

Murat OSMA · 19 Nisan 2013

Merhaba Mesut Bey,

Sheets("Sayfa1").Range("A1").CopyFromRecordset rs satırından sonra şu satırları ekleyip deneyiniz;

Kod:

Set rs = conn.Execute("select * from [Sayfa2$]")
Sheets("Sayfa1").Range("P1").CopyFromRecordset rs

Hem A1 hücresinden itibaren koşula göre verileri alır, hem de P1 hücresine herhangi bir koşul gerektirmeden sayfadaki tüm alanlarda bulunan verileri alır.

İki ayrı makro istediğiniz için, burada değiştirmeniz gereken sadece sorgunuz olacaktır.

İlk makroda sorgunuz bu şekilde iken;

Kod:

rs.Open "select * from [Sayfa2$] where SAYI=" & Range("n3").Value & ";", conn, 1, 1

İkinci makroda sorguyu bu şekilde değiştirebilirsiniz;

Kod:

rs.Open "select * from [Sayfa2$]", conn, 1, 1

mancubus · 19 Nisan 2013

eklediğiniz dosyalar boş. içinde hiç bir veri yok. bu nedenle test etmek imkansız. dosya eklenmesi de bu nedenle gereksiz olmuş.

Kod:

where SAYI=" & Range("a1:a3").Value

sadece sql sorgusunun ilgili kısmı için:

kriter RAKAM ise

Kod:

where SAYI=" & Range("A1").Value & " OR SAYI=" & Range("A2").Value & " OR SAYI=" & Range("A3").Value

kriter METİN ise (kriterin başına ve sonuna tek tırnak ' eklenir.)

Kod:

where SAYI='" & Range("A1").Value & "' OR SAYI='" & Range("A2").Value & "' OR SAYI='" & Range("A3").Value & "'"

veya ' yerine Chr(39)

Kod:

where SAYI=" & Chr(39) & Range("A1").Value & Chr(39) & " OR SAYI=" & Chr(39) & Range("A2").Value & Chr(39) & " OR SAYI=" & Chr(39) & Range("A3").Value & Chr(39)

bir deneyin.

vivident · 19 Nisan 2013

Çok teşekkür ediyorum arkadaşlar. Gerçekten süpersiniz. Beni büyük bir dertten kurtardınız. Kodlarda sizin dediğiniz gibi değişiklikler yaptım. Oldu da, tek olumsuz yönü dosyadaki verileri yüklüyorum. Yüklüyor, sonra kum saati tekrar çalışıyor, yine yüklüyor, sonra yine yüklüyor.. ESC tuşuna basıyorum durdurmak zorunda kalıyorum

Varmı bi düşünceniz ;
İlgili dosyalarını aynen ekliyorum

mancubus · 19 Nisan 2013

kritere göre veri çekmekten vaz geçtiniz galiba...

Kod:

Sub aktar()

    dosya = Application.GetOpenFilename
    If dosya = False Then Exit Sub
    
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.RECORDSET")
    
    conn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & dosya & ";" _
            & "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1""")
    strSQL = "SELECT * FROM [Smp99_Donnees$]"
    rs.Open strSQL, conn, adOpenStatic, adLockReadOnly
    
    With Sheets("Smp99_Donnees")
        'eski verinin silinmesi:
        .Range("A1:AZ" & Rows.Count).ClearContents
        'sütun başlıklarının 1. satıra yazdırılması:
        For i = 1 To rs.Fields.Count
            .Cells(1, i + 1).Value = rs.Fields(i - 1).Name
                'B sütunundan başlayarak yazılacağı için i+1
        Next i
        'SQL ile sutun başlığı (field name) hariç çekilen verinin yazdırılması:
        .Range("B2").CopyFromRecordset rs
        .Activate
    End With
    
    rs.Close
    conn.Close
    
    MsgBox "veriler yüklenmiştir" & vbLf & "anormallik durumunda : 6551", _
        vbOKOnly + vbInformation, Application.UserName

End Sub

mancubus · 19 Nisan 2013

office 1997 ile birlikte Workbook_Open olay kodu kullanılmaktadır.

uyumluluk amaçlı yürürlükte kalmaya devam eden module1'deki Aut

pen makrosunu silerek ThisWorkbook (BuÇalışmakitabı) kod modülüne aşağıdaki şekilde kopyalamanızı öneririm.

Kod:

Sub Workbook_Open()
    Sheets("Kullanım Klavuzu").Select
    Range("A1").Select
    MsgBox "Kod Dönüştürücü V1" & vbLf & _
    "Güncellenme : 15.04.2013", vbOKOnly + vbInformation, Application.UserName
End Sub

aynı şekilde kitabı kapatırken devreye giren Auto_Close da

Kod:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

End Sub

olmuştur.

vivident · 19 Nisan 2013

mancubus' Alıntı:

kritere göre veri çekmekten vaz geçtiniz galiba...

Kod:

Sub aktar()

    dosya = Application.GetOpenFilename
    If dosya = False Then Exit Sub
    
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.RECORDSET")
    
    conn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & dosya & ";" _
            & "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1""")
    strSQL = "SELECT * FROM [Smp99_Donnees$]"
    rs.Open strSQL, conn, adOpenStatic, adLockReadOnly
    
    With Sheets("Smp99_Donnees")
        'eski verinin silinmesi:
        .Range("A1:AZ" & Rows.Count).ClearContents
        'sütun başlıklarının 1. satıra yazdırılması:
        For i = 1 To rs.Fields.Count
            .Cells(1, i + 1).Value = rs.Fields(i - 1).Name
                'B sütunundan başlayarak yazılacağı için i+1
        Next i
        'SQL ile sutun başlığı (field name) hariç çekilen verinin yazdırılması:
        .Range("B2").CopyFromRecordset rs
        .Activate
    End With
    
    rs.Close
    conn.Close
    
    MsgBox "veriler yüklenmiştir" & vbLf & "anormallik durumunda : 6551", _
        vbOKOnly + vbInformation, Application.UserName

End Sub

Yukarıdaki kopyaladım ama olmadı malesef
makro hata verdi

mancubus · 19 Nisan 2013

biraz önce çalıştırdım. üstelik kriter de ekleyerek.
sorunsuz çalıştı. zaten sürekli kullandığım bir kod idi.
benim kullandığım şeklini ekleyeyim.

GetOpenFilename yerine doğrudan veri çekeceğim dosyanın ismini değişkende kullanmak dışında hemen hemen aynı. arzu ederseniz yine GetOpenFilename kullanmaya devam edersiniz, ilgili satırları silerek

Kod:

Sub Kapali_XL_Dosyasindan_Veri_Al()

    Dim Klasor As String, Dosya As String, tablo As String
    Dim strDB As String, strSQL As String, strKrit As String
    
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.RECORDSET")
    
    Klasor = "C:\Dosyalar\vs\" 'dosyanın bulunduğu klasör ismi; sonuna \ eklenerek
    Dosya = "veri_çekilecek_dosya_ismi.xlsm"
    strDB = Klasor & Dosya
    tablo = "Smp99_Donnees"
    strKrit = "AHMET"
    
    'sayfadaki tüm kayıtlar:
    strSQL = "SELECT * FROM [" & tablo & "$]"
    'sayfada kritere uyan tüm kayıtlar:
    'strSQL = strSQL & " WHERE [AD] = " & Chr$(39) & strKrit & Chr$(39)
    
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & strDB & ";" _
            & "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1""")
    rs.Open strSQL, cn, adOpenStatic, adLockReadOnly
    
    With Sheets("Smp99_Donnees")
        For i = 1 To rs.Fields.Count
            .Cells(1, i + 1).Value = rs.Fields(i - 1).Name
               'B sütunundan başlayarak yazılacağı için i+1
        Next i
        .Range("B2").CopyFromRecordset rs
    End With
    
    rs.Close
    cn.Close

End Sub

vivident · 19 Nisan 2013

rs.Open strSQL, conn, adOpenStatic, adLockReadOnly

hocam yukarıdakinide denedim yine aynı yerde üstteki satırda hata veriyor
dosyanın sayflarının isimlerine bakıyorum, aynı değişen yok, anlayamadım

Hocam rica etsem sizde çalışanı ek'e dosya olarak ekleyebilirmsiiniz

mancubus · 19 Nisan 2013

Kod:

rs.Open strSQL, conn, 1, 1

şeklinde dener misiniz?

vivident · 19 Nisan 2013

Sub aktar()
dosya = Application.GetOpenFilename
If dosya = False Then Exit Sub
Sheets("Smp99_Donnees").Range("A1:AZ" & Rows.Count).ClearContents
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.RECORDSET")
conn.Open "Provider=microsoft.ace.oledb.12.0;data source=" & dosya & ";extended properties=""excel 12.0;hdr=yes;imex=1"";"
rs.Open "select * from [Smp99_Donnees$]", conn, 1, 1
Sheets("Smp99_Donnees").Range("B2").CopyFromRecordset rs
Set rs = conn.Execute("select * from [Smp99_Donnees$]")
Sheets("Smp99_Donnees").Range("B2").CopyFromRecordset rs
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
Sheets("Smp99_Donnees").Select
MsgBox "veriler yüklenmiştir" & vbLf & _
"anormallik durumunda : 6551", vbOKOnly + vbInformation, Application.UserName

End Sub

-------------------------
Hocam bu kod çalışıyor. Aslında sizinki ile de aynı ama çözmüş değilim. Sadece sürekli güncelleme yapıyor hep. Seçenek ayarlarından manuel yaparsam hemen atıyor. Bence problem burada. Yani ben verileri çekerken dosya otomatik güncellemede olamyacak veya veriler çekildikten mesela 5 sn sonra güncellemeyi otomatik yapacak

mancubus · 19 Nisan 2013

kesinlikle aynı değil.

ilk eklediğiniz kodu kullanmaya devam ediyorsunuz...

vivident · 29 Nisan 2013

mancubus' Alıntı:
kesinlikle aynı değil.

ilk eklediğiniz kodu kullanmaya devam ediyorsunuz...

Hocam vermiş olduğunuz kodları denedim. olmadı. çalışan kod aşağıdaki kod olduğu için bunun üzerinden gittim. Sizin yayınladığınız kodun şu kısmında

rs.Open strSQL, conn, adOpenStatic, adLockReadOnly problem oluyor.

Benim kullandığım kodda ise; sürekli güncelleme yapıyor. ve değerleri değil, tümünü yapıştırıyor. rakamlar, sayılar felan metin olarak görülüyor. "Value" kodun hangi kısmına eklemem gerekiyor.

Sub aktar()
dosya = Application.GetOpenFilename
If dosya = False Then Exit Sub
Sheets("Smp99_Donnees").Range("A1:AZ" & Rows.Count).ClearContents
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.RECORDSET")
conn.Open "Provider=microsoft.ace.oledb.12.0;data source=" & dosya & ";extended properties=""excel 12.0;hdr=yes;imex=1"";"
rs.Open "select * from [Smp99_Donnees$]", conn, 1, 1
Sheets("Smp99_Donnees").Range("B2").CopyFromRecordset rs
Set rs = conn.Execute("select * from [Smp99_Donnees$]")
Sheets("Smp99_Donnees").Range("B2").CopyFromRecordset rs
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
Sheets("Smp99_Donnees").Select
MsgBox "veriler yüklenmiştir" & vbLf & _
"anormallik durumunda : 6551", vbOKOnly + vbInformation, Application.UserName
End Sub

vivident · 30 Nisan 2013

mancubus' Alıntı:
kesinlikle aynı değil.

ilk eklediğiniz kodu kullanmaya devam ediyorsunuz...

------------------------------------------
Sub aktar()

dosya = Application.GetOpenFilename
If dosya = False Then Exit Sub

Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.RECORDSET")

conn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & dosya & ";" _
& "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1""")
strSQL = "SELECT * FROM [Smp99_Donnees$]"
rs.Open strSQL, conn, 1, 1

With Sheets("Smp99_Donnees")
'eski verinin silinmesi:
.Range("A1:AZ" & Rows.Count).ClearContents
'sütun başlıklarının 1. satıra yazdırılması:
For i = 1 To rs.Fields.Count
.Cells(1, i + 1).Value = rs.Fields(i - 1).Name
'B sütunundan başlayarak yazılacağı için i+1
Next i
'SQL ile sutun başlığı (field name) hariç çekilen verinin yazdırılması:
.Range("B2").CopyFromRecordset rs
.Activate
End With

rs.Close
conn.Close

MsgBox "veriler yüklenmiştir" & vbLf & "anormallik durumunda : 6551", _
vbOKOnly + vbInformation, Application.UserName

End Sub
------------------------------------------
Hocam verdiğiniz kodları çalıştırmayı başardım;
rs.Open strSQL, conn, adOpenStatic, adLockReadOnly yazan kısmı rs.Open strSQL, conn, 1, 1 olarak değiştirdim. siz yukarıdaki mesajlarınızda belirtmişsiniz. Ama ya ben farkına varmadım, yada o an için olmadı

Tek sorun değer olarak yapıştırmıyor. Rakamlar metin formatında gözüküyor. Birde yapıştırılan sayfanın en üst satırı F1,F2,F3,F4,F5,F6 tarzı şeyler çıktı. Fotoğrafını ekliyorum

mancubus · 1 Mayıs 2013

13 no.lu mesajımda yazmıştım.
sonradan görmüşssünüz.

kendi bilgi birikimimle yazıyorum aşağıdakileri...

DAO-ADO kullanılacaksa...

excel dosyası = veri tabanı (database)
excel sayfası (worksheet) = tablo (table)
excel sütunu (column) = saha (field)
excel satırı (row) = kayıt (record)
excel 1. satır = saha adları (field names)
excel 2. satır ve sonrası = kayıtların tamamı (recordset)

eğer 1. satır bos ise ado-dao bunu boş bırakılmış "f"ieldname olarak kabul eder ve kendisi 1. sütundan başlayarak otomatik sütun başlığı ekler. F1, F2, vs ekler.

dolayısı ile bu yöntemle veri alınacaksa excel sayfasında sadece çekilecek veriler olmalı, 1. satırdan başlamalı. çünkü excel sayfasındaki her satır ve sütun veri tablo içeriği kayıt olarak değerlendirilir.

bunun üstesinden gelmeyi sağlayacak yöntemler var ise ado-dao içinde ben bilmiyorum; yardımcı olamam.

eğer yok ise, excel sayfası da olduğu gibi kalacaksa, excel dosyasının açrak alan kopylamak lazım. forumda bununla ilgili belki binlerce örnek var. mutlaka bir tanesi iş görür. forumda arama yapmanızı önereceğim.

iyi günler...

vivident · 2 Mayıs 2013

Yardımlarınızın için teşekkür ederim

İyi çalışmalar

Dosyalar arasında veri çekiyorum. makroda hata aldım

vivident

Ekli dosyalar

vivident

mancubus

Destek Ekibi

vivident

Murat OSMA

Altın Üye

mancubus

Destek Ekibi

vivident

Ekli dosyalar

mancubus

Destek Ekibi

mancubus

Destek Ekibi

vivident

Ekli dosyalar

mancubus

Destek Ekibi

vivident

mancubus

Destek Ekibi

vivident

mancubus

Destek Ekibi

vivident

vivident

Ekli dosyalar

mancubus

Destek Ekibi

vivident