• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kapalı Dosyaya Veri Kopyalama

tamer42' Alıntı:
Sn Korhan hocam, kayıt yapılacak dosya tamamen boş, ekte sunulmuştur.
Genişletmek için tıkla ...

Sorun orada zaten, tamamen boş olmamalı ..... 1. satırda en azından ilk 52 hücrenin dolu olması lazım. (A1:AZ1)

Kapalı dosyadaki sayfa adının da kodla uyumlu olması gerekir.

.
 
Haluk' Alıntı:
Sorun orada zaten, tamamen boş olmamalı ..... 1. satırda en azından ilk 52 hücrenin dolu olması lazım. (A1:AZ1)

Kapalı dosyadaki sayfa adının da kodla uyumlu olması gerekir.

.
Genişletmek için tıkla ...

Haluk Hocam teşekkürler,

bu kodla AZ1 hücresine yazabiliyoruz, bu veriyi AZ12 hücresine yazdırmak istesek nasıl bir yol izlemeleyiz?

Kod: 
    KAYIT_SETİ.MoveFirst
    KAYIT_SETİ.Fields(51).Value = "12345DENEME"
    KAYIT_SETİ.Update

iyi haftasonları
 
Tamer Bey, ADO konusu başlı başına bir deryadır..... burada 1-2 soru/cevapla dosyanızı toparlamanız zor olur.

Bence, Korhan Beyin dediği gibi klasik yöntemlerle gizli veya görünür olarak dosyayı açıp, klasik kodlamalarla istediğiniz yere verilerinizi yazdırmanız sizin için daha uygun olacaktır, diye düşünüyorum...

.
 
Veri tabanı olarak access kullanabilirsiniz.:cool:
 
ilginize teşekkürler
 
Kapalı dosyadan veri alırken font ve biçim alabilmemiz mümkünmü?
 
Kapalı dosyayı açarsanız alabilirsiniz.
 
Merhaba,

Kod: 
Cells(Satır, Sütun) = ExecuteExcel4Macro("'" & ThisWorkbook.Path & "\[Kitap1.xls]Sayfa1'!R" & Satır & "C" & Sütun & "")
ExecuteExcel4Macro yöntemi ile kapalı bir dosyadan hücre adresini vererek veri alabiliyoruz; bu işlemin ADO yöntemi kullanarak nasıl yapabiliriz?

özetle ADO yöntemiyle Kapalı dosyada herhangi bir hücre adresi vererek orada yazan veriyi nasıl aldırabiliriz?
Bununla ilgili örnek bir kod var mıdır?

Teşekkürler, iyi akşamlar
 
Deneyiniz.

C++: 
Option Explicit

Sub Test()
    Dim Dosya As String, Zaman As Double, Adres As String
    Dim Sorgu As String, Kayit_Seti As Object, Baglanti As Object
    
    Adres = Application.InputBox("Lütfen hücre adresini yazınız.", "Hücre Adresi")
    If Adres = "False" Or Adres = "" Then
        MsgBox "Lütfen hücre adresi yazınız!", vbCritical
        Exit Sub
    End If
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
    
    Dosya = ThisWorkbook.Path & "\Test.xlsm"

    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Sorgu = "Select * From [Sheet1$" & Adres & ":" & Adres & "]"
    
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
    
    If Kayit_Seti.RecordCount > 0 Then Range("A1").CopyFromRecordset Kayit_Seti
    
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
    
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
            
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
Bu da başka bir alternatif;

C++: 
Option Explicit

Sub Test()
    Dim Dosya As String, Zaman As Double, Adres As String
    Dim Sorgu As String, Kayit_Seti As Object, Baglanti As Object
    Dim Veri As Variant, Satir As Long, Sutun As Integer
    
    Adres = Application.InputBox("Lütfen hücre adresini yazınız.", "Hücre Adresi")
    If Adres = "False" Or Adres = "" Then
        MsgBox "Lütfen hücre adresi yazınız!", vbCritical
        Exit Sub
    End If
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
    
    Dosya = ThisWorkbook.Path & "\Test.xlsm"

    Satir = Range(Adres).Row
    Sutun = Range(Adres).Column

    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Sorgu = "Select * From [Sheet1$]"
    
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
    
    If Kayit_Seti.RecordCount > 0 Then
        Veri = Application.Transpose(Kayit_Seti.GetRows)
        If UBound(Veri, 1) > Satir And UBound(Veri, 2) > Sutun Then
            Range("A1") = Veri(Satir, Sutun)
            MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
                   "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
        Else
            MsgBox "Veri alınamıyor!" & vbLf & vbLf & _
                   Adres & " hücresi tablo dışında!", vbCritical
        End If
    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
            
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Korhan Ayhan' Alıntı:
Bu da başka bir alternatif;

C++: 
Option Explicit

Sub Test()
    Dim Dosya As String, Zaman As Double, Adres As String
    Dim Sorgu As String, Kayit_Seti As Object, Baglanti As Object
    Dim Veri As Variant, Satir As Long, Sutun As Integer
   
    Adres = Application.InputBox("Lütfen hücre adresini yazınız.", "Hücre Adresi")
    If Adres = "False" Or Adres = "" Then
        MsgBox "Lütfen hücre adresi yazınız!", vbCritical
        Exit Sub
    End If
   
    Zaman = Timer
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
   
    Dosya = ThisWorkbook.Path & "\Test.xlsm"

    Satir = Range(Adres).Row
    Sutun = Range(Adres).Column

    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
   
    Sorgu = "Select * From [Sheet1$]"
   
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
   
    If Kayit_Seti.RecordCount > 0 Then
        Veri = Application.Transpose(Kayit_Seti.GetRows)
        If UBound(Veri, 1) > Satir And UBound(Veri, 2) > Sutun Then
            Range("A1") = Veri(Satir, Sutun)
            MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
                   "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
        Else
            MsgBox "Veri alınamıyor!" & vbLf & vbLf & _
                   Adres & " hücresi tablo dışında!", vbCritical
        End If
    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
           
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
Genişletmek için tıkla ...

Korhan Hocam merhaba,
öncelikle teşekkürler
Burada InputBox' ta Hücre adresini C4 olarak yazdığımda ekli hata mesajını ( FROM yan tümcesinde söz dizimi hatası )alıyorum.
nerede hata yapıyor olabilirim.

iyi günler.
 

Ekli dosyalar

  • Resim1.jpg
    Resim1.jpg
    95.1 KB · Görüntüleme: 8
  • Resim2.jpg
    Resim2.jpg
    102.5 KB · Görüntüleme: 7
Sondaki köşeli parantez fazla olmuş.

[icmal$]
 
tamer42' Alıntı:
çok teşekkürler Korhan Hocam
iyi akşamlar.
Genişletmek için tıkla ...

Korhan Hocam aşağıdaki kodda kayıt sayısı hep 0 geldiği için verileri alamıyorum, nerede hata yapıyor olabiliriz?
Teşekkürler
iyi çalışmalar.

Kod: 
Sub xlAdobCat()
Dim Con As Object
Dim RS As Object
Dim x As Long, Son As Long
Dim yol As String, MyFile As String
Dim Sorgu As String, Tbl As String

Sheets("Sheet1").Select

Range("A:G").ClearContents

Set Con = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.recordset")
Set cat = CreateObject("ADOX.Catalog")

yol = ThisWorkbook.Path

MyFile = yol & "\" & "Satış.xlsx"

x = 1

Con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
   MyFile & ";extended properties=""Excel 12.0;hdr=yes"""

cat.ActiveConnection = Con

For Each Table In cat.tables
Tbl = Table.Name

       Sorgu = "Select * From [" & Tbl & "C5:C5]"
     
    RS.Open Sorgu, Con, 1, 1

    Cells(x, 1) = Replace(Tbl, "$", "")
    If RS.RecordCount > 0 Then Range("B" & x).CopyFromRecordset RS
    
    Tbl = ""
    Sorgu = ""
    RS.Close
    
x = x + 1

Next

Con.Close
Cells.EntireColumn.AutoFit

End Sub
 

Ekli dosyalar

Bağlantı metnindeki başlıklar parametresini No olarak değiştirin.

Con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
MyFile & ";extended properties=""Excel 12.0;hdr=Yes"""
 
Korhan Ayhan' Alıntı:
Bağlantı metnindeki başlıklar parametresini No olarak değiştirin.

Con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
MyFile & ";extended properties=""Excel 12.0;hdr=Yes"""
Genişletmek için tıkla ...
Çok teşekkürler,
demek oluyor ki bazen basit düşünmek gerekiyor.
 
Korhan Ayhan' Alıntı:
Bağlantı metnindeki başlıklar parametresini No olarak değiştirin.

Con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
MyFile & ";extended properties=""Excel 12.0;hdr=Yes"""
Genişletmek için tıkla ...

Korhan hocam birde Kaynak dosyada sayfa numarasını nümerik değer olduğunda hata verdi, bunu nasıl aşabiliriz?

tekrar teşekkürler, iyi çalışmalar.

221482
 

Ekli dosyalar

  • 1601543275195.png
    1601543275195.png
    29.8 KB · Görüntüleme: 0
Sorgu satırını aşağıdaki gibi değiştirip deneyiniz.

Sorgu = "Select * From [" & Replace(Tbl, "'", "") & "C5:C5]"
 
Korhan Ayhan' Alıntı:
Sorgu satırını aşağıdaki gibi değiştirip deneyiniz.

Sorgu = "Select * From [" & Replace(Tbl, "'", "") & "C5:C5]"
Genişletmek için tıkla ...
Teşekkürler Korhan Hocam, sağolun varolun,
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst