Kapalı Dosyaya Veri Kopyalama

Haluk · 4 Nisan 2020

tamer42' Alıntı:
Sn Korhan hocam, kayıt yapılacak dosya tamamen boş, ekte sunulmuştur.

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.

.

tamer42 · 4 Nisan 2020

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.

.

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ı

Haluk · 4 Nisan 2020

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...

.

Orion1 · 4 Nisan 2020

Veri tabanı olarak access kullanabilirsiniz.

tamer42 · 4 Nisan 2020

ilginize teşekkürler

ikikan · 2 Mayıs 2020

Kapalı dosyadan veri alırken font ve biçim alabilmemiz mümkünmü?

Korhan Ayhan · 2 Mayıs 2020

Kapalı dosyayı açarsanız alabilirsiniz.

tamer42 · 30 Eylül 2020

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

Korhan Ayhan · 30 Eylül 2020

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

Korhan Ayhan · 30 Eylül 2020

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

tamer42 · 30 Eylül 2020

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

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.

Korhan Ayhan · 30 Eylül 2020

Sondaki köşeli parantez fazla olmuş.

[icmal$]

tamer42 · 30 Eylül 2020

Korhan Ayhan' Alıntı:
Sondaki köşeli parantez fazla olmuş.

[icmal$]

çok teşekkürler Korhan Hocam
iyi akşamlar.

tamer42 · 1 Ekim 2020

tamer42' Alıntı:
çok teşekkürler Korhan Hocam
iyi akşamlar.

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

Korhan Ayhan · 1 Ekim 2020

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"""

tamer42 · 1 Ekim 2020

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"""

Çok teşekkürler,
demek oluyor ki bazen basit düşünmek gerekiyor.

tamer42 · 1 Ekim 2020

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"""

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.

Korhan Ayhan · 1 Ekim 2020

Sorgu satırını aşağıdaki gibi değiştirip deneyiniz.

Sorgu = "Select * From [" & Replace(Tbl, "'", "") & "C5:C5]"

tamer42 · 1 Ekim 2020

Korhan Ayhan' Alıntı:
Sorgu satırını aşağıdaki gibi değiştirip deneyiniz.

Sorgu = "Select * From [" & Replace(Tbl, "'", "") & "C5:C5]"

Teşekkürler Korhan Hocam, sağolun varolun,

Kapalı Dosyaya Veri Kopyalama

Özel Üye

Destek Ekibi

Özel Üye

Uzman

Destek Ekibi

Administrator

Destek Ekibi

Administrator

Administrator

Destek Ekibi

Ekli dosyalar

Administrator

Destek Ekibi

Destek Ekibi

Ekli dosyalar

Administrator

Destek Ekibi

Destek Ekibi

Ekli dosyalar

Administrator

Destek Ekibi