Kapalı Dosya Birinci Hücreden

[5353]

Ctrlv dosyam var. Report.xls dosyasından nasıl veri alırım. Sitemizde bulduğum kod "Subscript out of range" hatası verdi. Nasıl yapabilirim? Ek dosya örnek, Kod aşağıda.
***************************************

Option Explicit

Sub Verileri_Aktar()
Dim Dosya As String, S1 As Worksheet, Baglanti As Object
Dim Sorgu As String, Kayit_Seti As Object, X As Integer, Zaman As Double

Dosya = "C:\Users\murat.topal\Downloads\Report.xls"

Zaman = Timer

If Dir(Dosya) <> "" Then
Set Baglanti = CreateObject("AdoDb.Connection")
Set Kayit_Seti = CreateObject("AdoDb.Recordset")
Set S1 = Sheets("Rapor")

S1.Cells.ClearContents

If Dosya <> ThisWorkbook.FullName Then
Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
Dosya & ";Extended Properties=""Excel 12.0;Hdr=Yes"""

Sorgu = "Select * From [Veriler$]"
Kayit_Seti.Open Sorgu, Baglanti, 1, 1
If Kayit_Seti.RecordCount > 0 Then
S1.Range("A1").CopyFromRecordset Kayit_Seti
For X = 0 To Kayit_Seti.Fields.Count - 1
S1.Cells(1, X + 1) = Kayit_Seti.Fields(X).Name
Next
S1.Columns.AutoFit
End If

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

Set Kayit_Seti = Nothing
Set Baglanti = Nothing
Set S1 = Nothing

MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
"İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
Else
MsgBox "Veri alınacak dosya bulunamadı!", vbCritical
End If
End Sub

 

[5353]

GÜNCEL kapalı dosya işi zor sanırım.

 

[Korhan Ayhan]

Aslında zor değil..

Sanki konu başlığınız bile eksik kalmış..

Ayrıca siz hiç açıklama yapmamışsınız. Bu sebeple bu tarz sorulara kimse cevaplamak için çaba sarf etmez.

Paylaştığınız kodu sanırım ben yazmıştım.

Bu tarz kodlar veritabanı mantığı ile tutulan tablolarda daha iyi sonuç vermektedir.

Ek olarak kod içinde dosya adı olarak Report.xls yazmışsınız ama paylaştığınız dosyanızın uzantısı ".xlsx" bu sebeple hata alırsınız.
Ayrıca sayfa adı olarak Veri kullanılmış. Ama dosyanızın içindeki sayfa adı ise Report bu sebeple yine hata alırsınız. Bunları dikkatli bir şekilde revize etmeniz gerekir.

Siz "Report.xlsx" dosyasındaki hangi verileri hangi formatta aktarmak istiyorsunuz?

 

[5353]

Sizin bir çok kodunuzu burada denedim. Eksiklik şüphesiz bende. Kod üzerinden ezber gidiyorum. Aslında Report.xls dosyasını A1 den başlayarak CTRL V dosyasına aktarmak istiyorum. Bunu hedef ile yapabilirim ama daha kolay kapalı dosyadan almak istiyorum. Report dosyasından CTRLV dosyasına A sütünündan K sütününa kadar almak.

 

[Korhan Ayhan]

Ado kodları ile sadece verileri alabilirsiniz. Biçimleri aktaramazsınız.

 

[5353]

ona da razıyım

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Verileri_Aktar()
    Dim Dosya As String, S1 As Worksheet, Baglanti As Object
    Dim Sorgu As String, Kayit_Seti As Object, X As Integer, Zaman As Double
    
    Dosya = ThisWorkbook.Path & "\Report.xlsx"
    
    Zaman = Timer
    
    If Dir(Dosya) <> "" Then
        Set Baglanti = CreateObject("AdoDb.Connection")
        Set Kayit_Seti = CreateObject("AdoDb.Recordset")
        Set S1 = Sheets("ctrlv")
        
        S1.Cells.ClearContents
        
        If Dosya <> ThisWorkbook.FullName Then
            Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
            Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
            
            Sorgu = "Select * From [Report$]"
            Kayit_Seti.Open Sorgu, Baglanti, 1, 1
            If Kayit_Seti.RecordCount > 0 Then
                S1.Range("A1").CopyFromRecordset Kayit_Seti
                S1.Columns.AutoFit
            End If
            
            If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
            If Baglanti.State <> 0 Then Baglanti.Close
        End If
            
        Set Kayit_Seti = Nothing
        Set Baglanti = Nothing
        Set S1 = Nothing
            
        MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
        "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Veri alınacak dosya bulunamadı!", vbCritical
    End If
End Sub

 

[5353]

Teşekkürler ustad.
Dosya = ThisWorkbook.Path & "C:\Users\murat.topal\Downloads\Report.xls"

Report.xls uzantısı ve CTRLV dosyası masa üstünde, kaynak dosya "C:\Users\murat.topal\Downloads\Report.xls" bu değişiklikte nasıl yamalıyım kodu.

 

[Korhan Ayhan]

Dosya = Adres

Olarak düzenlemelesiniz. Adres yerine dosyanın tam yolunu yazınız.