Ado Connection YARDIMINIZA Ihtiyacim var

[Maksim]

Herkese merhaba
Private Sub CommandButton1_Click()
Dim ConnectString, SQLstring, QueryResult

ConnectString = "ODBC;DRIVER=SQL Server;SERVER=" & TextBox1 & ";UID=;APP=Microsoft Office 2003;WSID=PL04;Trusted_Connection=Yes; DATABASE=" & TextBox2 & "" _

SQLstring = "SELECT * FROM borc_alacak_euro where BAKIYE>0 ORDER BY UNVANI"

Set NewBook = Workbooks.Add 'Application.TemplatesPath + "Template.XLT")
With NewBook.Sheets(1).QueryTables.Add(Connection:=ConnectString, Destination:=NewBook.Sheets(1).Range("G15"), Sql:=SQLstring)
.BackgroundQuery = False
.FieldNames = False
.RefreshStyle = xlOverwriteCells
.Refresh BackgroundQuery:=False
End With
End Sub
Bu kodlamada her Şey iyi çalışıyor.Bu kodlamaya yeni bir SQLstring eklemek stiyorum
SQLstring 2 diyelim SELECT * FROM borc_alacak_AZN where BAKIYE>0 ORDER BY UNVANI bunu bana Range Range("A15"),
SQLstring 3 diyelim SELECT * FROM borc_alacak_USD where BAKIYE>0 ORDER BY UNVANI bunu bana Range Range("F15"), VERSİN.
Bu konuda bana yardım ede bilirmisiniz?
İlginiz için teşekkürler

 

[Ferhat Pazarçevirdi]

Aşağıdaki gibi bir kod dizayn edilebilir. İnceleyiniz.

Private Sub CommandButton1_Click()
    Call Sorgula("SELECT * FROM borc_alacak_euro where BAKIYE>0 ORDER BY UNVANI", Range("G15"))
    Call Sorgula("SELECT * FROM borc_alacak_AZN where BAKIYE>0 ORDER BY UNVANI", Range("A15"))
    Call Sorgula("SELECT * FROM borc_alacak_USD where BAKIYE>0 ORDER BY UNVANI", Range("F15"))
End Sub
[COLOR=darkgreen]'----------------------------------[/COLOR]
Private Sub Sorgula(sql As String, rng As Range)
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim alan As ADODB.Field
    Dim sql As String
    Dim iAlanIndexi As Integer
    
[COLOR=darkgreen]    'Connection string konusunda emin değilim, denemek lazım..
    'Aşağıdaki bağlantı stringi işe yaramazsa
    'connectionstrings.com adresinden SQL Server'ınıza uygun bir
    'bağlantı stringi seçiniz[/COLOR]
    
    cn.ConnectionString = "Driver={SQL Server};" & _
                          "Server=" & TextBox1 & ";" & _
                          "Database=" & TextBox2 & ";" & _
                          "Trusted_Connection=Yes;"
    cn.Open
    
    rs.Open sql, cn, 1, 3
    
    If rs.RecordCount > 0 Then
        rng = rs(0)
[COLOR=darkgreen]        'bu kısımda ben sadece Recordset'in ilk kaydı için ilk elemanı aldım
        'siz isterseniz, tüm alanları ve kayıtları bir döngü ile
        'istediğiniz hücrelere yazdıraabilirsiniz.
        
        'Mesela aşağıdaki gibi bir döngü kurulabilir.
        '---------------------
        'istr = rng.Row
        'Do Until rs.EOF
            'istr=istr+1
            'For Each alan In rs.Fields
                'rng.Offset(istr, iAlanIndexi) = rs(alanindexi)
                'iAlanIndexi = iAlanIndexi + 1
            'Next
            'rs.MoveNext
        'Loop
        '----------------------
[/COLOR]    Else
        MsgBox sql & vbLf & "sorgusu için uygun kayıt bulunamadı"
    End If
    cn.Close: rs.Close
    Set cn = Nothing: Set rs = Nothing
End Sub

 

[Maksim]

Teşekkür ederim...