Excel'e veri alma hatasi

 

Bir arkadasin yapmis oldugu programi ben baska excelde çalistirmak istedim fakat birtürlü olmadi yardimlarinizi talep ediyorum.

Sirketler sayfasinda problem yok veriler gayet güzel geliyor fakat rapor almak istedigim zaman birtürlü olmuyor.

 

Private Sub CommandButton1_Click()
Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim SqlText As String
 With conn
    .Provider = "sqloledb"
    .CommandTimeout = 120
    .ConnectionString = "Data Source=" & Sayfa1.Cells(4, 5).Value & ";USER ID=" & Sayfa1.Cells(8, 5).Value & ";PASSWORD=" & Sayfa1.Cells(10, 5).Value & ";AUTO TRANSLATE=FALSE"
    .Open
    .DefaultDatabase = Sayfa1.ComboBox1.Text
    End With
    SqlText = "SELECT A.SC_NO,A.VADETRH,A.SC_VERENK,"
    SqlText = SqlText + " B.CARI_ISIM,A.SC_ABORCLU,"
    SqlText = SqlText + " A.YERI,A.CEKSERI,A.SC_VERILENK,(CASE WHEN SC_YERI='T' THEN C.ACIKLAMA ELSE (SELECT D.CARI_ISIM FROM TBLCASABIT D WHERE D.CARI_KOD=A.SC_VERILENK) END),A.RAPOR_KODU,"
    SqlText = SqlText + " A.TUTAR"
    SqlText = SqlText + " FROM TBLMCEK A WITH (NOLOCK) JOIN TBLCASABIT B WITH (NOLOCK) ON (A.SC_VERENK=B.CARI_KOD)"
    SqlText = SqlText + " LEFT OUTER JOIN TBLBNKHESSABIT C WITH (NOLOCK) ON (A.SC_VERILENK=C.NETHESKODU)"
    SqlText = SqlText + " WHERE A.VADETRH BETWEEN '" + Format$(Sayfa7.Cells(2, 2), "yyyy-mm-dd") + "' AND '" + Format$(Sayfa7.Cells(3, 2), "yyyy-mm-dd") + "'"
    SqlText = SqlText + " AND A.SC_SONDUR='" & Sayfa7.Cells(2, 1).Value & "'"
    SqlText = SqlText + " AND A.SC_YERI='" & Sayfa7.Cells(3, 1).Value & "'"
    SqlText = SqlText + " ORDER BY A.VADETRH ASC"
    rs.Open SqlText, conn, adOpenStatic, adLockReadOnly
    Sayfa7.Range("B11:M10000").ClearContents
    Sayfa7.Activate
    i = 11
    Do While Not rs.EOF
        Sayfa7.Cells(i, 2).Value = rs(0)
        Sayfa7.Cells(i, 3).Value = rs(1)
        Sayfa7.Cells(i, 4).Value = rs(2)
        Sayfa7.Cells(i, 5).Value = rs(3)
        Sayfa7.Cells(i, 6).Value = rs(4)
        Sayfa7.Cells(i, 7).Value = rs(5)
        Sayfa7.Cells(i, 8).Value = rs(6)
        Sayfa7.Cells(i, 9).Value = rs(7)
        Sayfa7.Cells(i, 10).Value = rs(8)
        Sayfa7.Cells(i, 11).Value = rs(9)
        Sayfa7.Cells(i, 12).Value = rs(10)
        rs.MoveNext
        i = i + 1
    Loop
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing

End Sub

 

 

Sanirim hata (kirmizi ) bu kisimda F8 ile çalistirdigim zaman burayi atliyor

 

Söyle bir uyari verdi nesne kapali oldugundan uygulama baslatilamadi