CopyFromRecordset in een Listbox

[u172468]

Beste Helpers,

Ik ben bezig met een bestand waarin een aantal querys draaien. Nu selecteert de query gegevens en plaatst deze op een tabblad. Nu wil ik dat dit in een Listbox geplaatst kan worden zonder eerst op een tabblad. Ik zal de code bijvoegen:

Private Sub SELECT_Database_Medewerkers()

Dim sSQLQry As String
Dim ReturnArray
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset

Dim DBPath As String, sconnect As String

DBPath = "C:Data\vestigingen\Database.xls"

sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"

Conn.Open sconnect
    sSQLSting = "SELECT * From [Vakantie$] "

    
    mrs.Open sSQLSting, Conn
        
        Sheets("Blad3").Range("A1").CopyFromRecordset mrs
   
    mrs.Close

Conn.Close

End Sub

Het gaat om het stuk: Sheets("Blad3").Range("A1").CopyFromRecordset mrs

Ik hoop dat iemand het weet.

Alvast bedankt!

 

[OctaFish]

Met zoiets misschien:

    rcArray= rst.GetRows
    With Me.JouwLijst
        .ColumnCount = 2 'Of welk aantal dan ook
        .Clear
        .List = Application.Transpose(rcArray)
        .ListIndex = -1
    End With

 

[snb]

of:

Private Sub UserForm_Initialize()
    With CreateObject("ADODB.recordset")
        .Open "SELECT * FROM Q_test", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=G:\Access\fiets.mdb"
        ComboBox1.Column = .GetRows
        ComboBox1.ColumnCount = UBound(ComboBox1.List, 2) + 1
    End With
End Sub

PS. Zowel .clear als .listindex=-1 zijn in dit geval overbodig.

 

[u172468]

Top! De code werkt nu.:d
Weet je ook toevallig hoe je eea in een txtbox ob label kunt krijgen?

 

[OctaFish]

Wat wil je precies in een tekstvak hebben? De complete recordset?

 

[u172468]

Nee, 1 waarde.

 

[snb]

Private Sub ComboBox1_Change()
    TextBox1.Text = ComboBox1.List(ComboBox1.ListIndex, 0)
End Sub

 

[u172468]

Dat is niet precies wat ik bedoel. Het moet dit zijn maar dan voor een textbox of Label. Of ik lees de laatste code niet goed...

   rcArray= rst.GetRows
    With Me.JouwLijst
        .ColumnCount = 2 'Of welk aantal dan ook
        .Clear
        .List = Application.Transpose(rcArray)
        .ListIndex = -1
    End With

 

[u172468]

Ik heb het toch gevonden. Bedankt voor de hulp.

 Sub VullenTxt()
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSQL As String
 
' check to see if anything has been selected in combobox
  ' If ComboBox1.ListIndex = -1 Then Exit Sub
 
   strSQL = "SELECT [Voornaam],[Achternaam] "
   strSQL = strSQL & " FROM [Blad1$] "
   strSQL = strSQL & " WHERE [Pers]= '068'"
 
  cnn.Open sConnect
   rst.Open strSQL, cnn, adOpenStatic
 
   rst.MoveFirst
 
   If Not rst.EOF Then
    Menu.MijnAccountPgeb = rst.Fields("Voornaam").Value
      'TextBox2.Value = rst.Fields("Field2").Value
   Else
      MsgBox "No records found"
   End If
 
   rst.Close
 
   cnn.Close
 
   Set rst = Nothing
   Set cnn = Nothing
End Sub

 

[snb]

Alle gegevens staan al in de combobox, dus een nieuwe selectie uit de database is 100 % overbodig.