Soru Makro hatası error -2147217904 ( 80040e10)`

Katılım
11 Şubat 2021
Mesajlar
106
Excel Vers. ve Dili
2019, rus
Merhaba dosyadaki bu kod düne kadar çalışıyorken, bu gün hata verdi, sorun ne acaba?
Kod:
Sub XLBirlestir()
'hy__________________________________________Excel Excel Bağla Referanslı
'önce referanslardan mirosoft ActiveX Data Object x.x library eklenmeli
Set Syf = ThisWorkbook.Worksheets("TOTAL")
sonStr = Syf.Cells(Syf.Rows.Count, "B").End(xlUp).Row
If sonStr < 4 Then sonStr = 4
Syf.Range("B4:F" & sonStr).ClearContents
Sheets("TmpTotal").Cells.Clear

Dim SQL As String
Dim ADO_RS As ADODB.Recordset
Dim ADO_CN As ADODB.Connection

AnaKlsr = ThisWorkbook.Path & "\Data\"
DtDsy = Dir(AnaKlsr & "*.xlsx")
    Do While DtDsy <> ""
    SqlDsy = SqlDsy & _
                    "Union all " & _
                    "SELECT *  " & _
                    "FROM [Hesabat$] IN """ & AnaKlsr & DtDsy & """ ""EXCEL 8.0;"" "
        DtDsy = Dir
    Loop
SqlDsy = Mid(SqlDsy, 11)

SQL = "SELECT * " & _
      "FROM (" & SqlDsy & ")  AS A " & _
      "WHERE (((A.F1) Is Not Null)) OR (((A.F1)>0)) ;"

Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection

ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _
                          ";extended properties=""excel 8.0;hdr=No"""
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1

'   Eğer Hiç Kayıt Yoksa
If ADO_RS.RecordCount = 0 Then
    MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
    GoTo son
End If
ADO_RS.MoveLast
ADO_RS.MoveFirst

Sheets("TmpTotal").Range("A1").CopyFromRecordset ADO_RS

ADO_RS.Close

'hy_____________________________________ToplaRS
SQL = "SELECT [F2], Sum([F3]) AS TplA3, Sum([F4]) AS TplA4, Sum([F5]) AS TplA5, Sum([F6]) AS TplA6 " & _
      "FROM [TmpTotal$] " & _
      "GROUP BY [F2];"

Set ADO_RS = New ADODB.Recordset
    ADO_RS.Open SQL, ADO_CN, 3, 1

'   Eğer Hiç Kayıt Yoksa
If ADO_RS.RecordCount = 0 Then
    MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
    GoTo son
End If
ADO_RS.MoveLast
ADO_RS.MoveFirst

Sheets("Total").Range("B4").CopyFromRecordset ADO_RS
son:
ADO_RS.Close
ADO_CN.Close
'hy_____________________________________ToplaRS
Sheets("TmpTotal").Cells.Clear
Set ADO_RS = Nothing
Set ADO_CN = Nothing
End Sub
 
Katılım
11 Şubat 2021
Mesajlar
106
Excel Vers. ve Dili
2019, rus
HAta mesajında şöyle diyor:
Bir veya daha fazla gerekli parametrede bir değer eksik.
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Hatanın ne olduğunu ve nasıl düzeldiğini açıklarsanız,
Belki aynı hatayla ilgili arama yapan bir kullanıcıya faydası olur. Forum da gayesine ulaşmış olur.
 
Katılım
11 Şubat 2021
Mesajlar
106
Excel Vers. ve Dili
2019, rus
Kod:
'hy_____________________________________ToplaRS
SQL = "SELECT [F2], Sum([F3]) AS TplA3, Sum([F4]) AS TplA4, Sum([F5]) AS TplA5, Sum([F6]) AS TplA6 " & _
      "FROM [TmpTotal$] " & _
      "GROUP BY [F2];"
Burda " Sum([F6]) AS TplA6 " bu satır excel dosyasında olmadığı için hata veriyormuş, önceden vardı, sonra sildim, koddan silmeyi unutmuşum. Sum([F6]) AS TplA6 - bunu sildiğimde çalıştı.
 
Üst