kapalı dosyadan veri alma makrosu 2013 office çalışmıyor neden?

[mars2]

İyi Günler;
excel.xls hazırlamış tabloma aşağıdaki makro ile kapalı dosyalaradan veri almaktayım. Ancak, Win8 ve office 2013 yüklü bilgisayarda çalışmamakta neden kaynaklanmaktadır.

Sub verial()

On Error Resume Next

Dim conn As ADODB.Connection, rs As ADODB.Recordset
Dim j As Integer, i As Byte, tpl As Double, dosya As String, son As Integer
Dim no As String, arr()

Sheets("yıllar").Select
If Range("B12").Value = "" Then
MsgBox "İSİM YAZILMAMIŞ" & vbLf & "DİKKAT! BİR İSİM GİRMELİSİNİZ.", vbCritical, "UYARI"
Range("B12").Select
Exit Sub
End If

no = Range("B12").Value
Range("B21:R32").ClearContents
son = Cells(20, "IV").End(xlToLeft).Column
Application.ScreenUpdating = False

For j = 2 To son
If Dir(ThisWorkbook.Path & "\" & Cells(20, j).Value & ".xls") <> "" Then
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open ("provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & "\" & Cells(20, j).Value & ".xls;extended properties=""excel 8.0;hdr=no;IMEX=1"";")
rs.Open "Select * from [toplam$c265536] where F1='" & [B12] & "';", conn, adOpenKeyset, adLockReadOnly
arr = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
rs.MoveFirst
Do While Not rs.EOF
For i = 21 To 32
If Not IsNull(rs(i - 20).Value) Then
arr(i - 20) = arr(i - 20) + rs(i - 20).Value
End If
Next i
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
For t = 21 To 32
Cells(t, j).Value = arr(t - 20)
Next
Erase arr
End If
Next j
Application.ScreenUpdating = True

MsgBox "İŞLEM TAMAMLANMIŞTIR." & vbLf & _
"DOSYA BAZINDA 2009-2024 YILLARI İÇİN", vbOKOnly + vbInformation, " S E R V İ S İ"



End Sub

 

[Orion1]

referance'den microsoft activex data object library 2.8 seçtinizmi?

 

[3skiya]

Bende çözemedim ama sanki kodlar değişmiş gibi benimde bazı formüllerim çalışmıyor :/

 

[mars2]

Sayın Orion1;
İlginize teşekkürler, ancak, referance'den microsoft activex data object library 2.8 seçmeme rağmen, yine olmadı, office 2013 ve 64 bittir.