Write ADO SQL results to Userform Spreadsheet1 control

I have the following working. The code between the *** is what I am looking to change. I would prefer writing the result of the SQL directly to my userform spreadsheet control rather than sending it to a worksheet then pasting it to the spreadsheet control.

Any help would be appreciated.

Thanks,

Kurt

Code:

---

Public Sub PopulateSpreadsheet()
  Dim cnn As New ADODB.Connection
  Dim rst As New ADODB.Recordset
  Dim MySQLcheck As String
  Dim intFieldCount, i As Integer
 
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=S:\Sunkist\Sunkist.mdb"
 
MySQLcheck = "select * from XXXFG_Leadtime where WH_From = '" & UF_WorkOrder.MultiPage1(1).oCB1.Value & "';"
 
Set rst = cnn.Execute(MySQLcheck)

intFieldCount = rst.Fields.Count
rst.MoveFirst
 
'*****************************************************
Sheet1.Cells.ClearContents
For i = 0 To intFieldCount - 1
    With Sheet1.Range("A1").Offset(0, i)
        .Value = rst.Fields(i).Name
    End With
Next
'*****************************************************
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
End Sub

---

[vba]

'*****************************************************
Sheet1.Cells.ClearContents
For i = 0 To intFieldCount - 1
With Sheet1.Range("A1").Offset(0, i)
Userform1.Controls("TextBox" & i).Text = rst.Fields(i).Name
End With
Next
'*****************************************************
[/vba]

Does this mean that the other thread is dead?

Xld -

I have a Spreadsheet1 control on a Userform. I want to see it I can get the result from the SQL directly on UF_WorkOrder.MultiPage1(1).Spreadsheet1 not on an activesheet.

I'm not sure how to apply your code to that.

Kurt

The other is still open.

I have never used the spreadsheet control, so can yoiu show me how you load it, and I am sure I can do the rest.

Xld - I appreciate you looking at this.
These are the steps I tak in order. As you can see - piece 1 calls it, piece 2 puts it into a worksheet range, & the third does a simple copy paste.

Code:

---

Private Sub oTB2_AfterUpdate()
Me.oTB3.Value = Format(Date, "mm / dd / yyyy")
Me.oTB3.Visible = True
Me.oLbl6.Visible = True
Me.oTB4.Visible = True
Me.oLbl7.Visible = True
Call PopulateSpreadsheet
Call GetRecords
Call CleanupFill
Me.oTB5.Visible = True
Me.oLbl8.Visible = True
Me.oTB5.SetFocus
End Sub

---

Code:

---

Public Sub PopulateSpreadsheet()
    On Error GoTo UserForm_Initialize_Err
    Dim intFieldCount, I As Integer
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=S:\Sunkist\Sunkist.mdb"
MySQLcheck = "select * from XXXFG_Leadtime where WH_From = '" & UF_WorkOrder.MultiPage1(1).oCB1.Value & "';"
Set rst = cnn.Execute(MySQLcheck)
intFieldCount = rst.Fields.Count
rst.MoveFirst
Sheet1.Cells.ClearContents
For I = 0 To intFieldCount - 1
    With Sheet1.Range("A1").Offset(0, I)
        .Value = rst.Fields(I).Name
    End With
Next
 
 
UserForm_Initialize_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
UserForm_Initialize_Err:
'    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
    Resume UserForm_Initialize_Exit
End Sub

---

Code:

---

Public Sub GetRecords()
    Dim rngTarget As Range
    MySQLcheck = "SELECT [WH_From],[WH_To],[Total_Days_Req],[To_Schedule],[Production_Days],[QA_Incubation],[Load_Time],[On_Water],[Truck_To_Whse] from XXXFG_Leadtime where [WH_From] = '" & UF_WorkOrder.MultiPage1(1).oCB1.Value & "' AND [WH_To] = '" & UF_WorkOrder.MultiPage1(1).oCB2.Value & "';"
    Set rngTarget = ActiveSheet.Range("A2")
    Call RetrieveRecordset(MySQLcheck, rngTarget)
End Sub

---

Code:

---

Public Sub CleanupFill()
    Sheet1.Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Replace What:="_", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    Sheet1.Range("A1").Select
    Range(Selection.End(xlDown), Selection.End(xlToRight)).Select
    Selection.Copy
    With Application
        .ScreenUpdating = False
        With UF_WorkOrder.MultiPage1(1).oSpreadsheet1.ActiveSheet
            .Range("A1").Paste
            .Range("A1").Select
            .Columns.AutoFitColumns
        End With
        .CutCopyMode = False
        .ScreenUpdating = True
        DoEvents
    End With
End Sub

---

Code:

---

Public Sub RetrieveRecordset(MySQLcheck As String, clTrgt As Range)
    Dim cnt As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim rcArray As Variant
    Dim lFields As Long
    Dim lRecrds As Long
    Dim lCol As Long
    Dim lRow As Long
    cnt.Open glob_sConnect
    rst.Open MySQLcheck, cnt
 
    lFields = rst.Fields.Count
    If Val(Mid(Application.Version, 1, InStr(1, Application.Version, ".") - 1)) > 8 Then
        On Error Resume Next
        clTrgt.CopyFromRecordset rst
 
        If Err.Number <> 0 Then GoTo EarlyExit
 
    Else
        rcArray = rst.GetRows
        lRecrds = UBound(rcArray, 2) + 1
        For lCol = 0 To lFields - 1
            For lRow = 0 To lRecrds - 1
 
                If IsDate(rcArray(lCol, lRow)) Then
                    rcArray(lCol, lRow) = Format(rcArray(lCol, lRow))
 
                ElseIf IsArray(rcArray(lCol, lRow)) Then
                    rcArray(lCol, lRow) = "Array Field"
                End If
            Next lRow
        Next lCol
 
        clTrgt.Resize(lRecrds, lFields).Value = TransposeDim(rcArray)
    End If
EarlyExit:
 
    rst.Close
    cnt.Close
    Set rst = Nothing
    Set cnt = Nothing
    On Error GoTo 0
End Sub
Private Function TransposeDim(V As Variant) As Variant
    Dim x As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim tempArray As Variant
    Xupper = UBound(V, 2)
    Yupper = UBound(V, 1)
    ReDim tempArray(Xupper, Yupper)
    For x = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(x, Y) = V(Y, x)
        Next Y
    Next x
    TransposeDim = tempArray
End Function

---

Wow. That surprised me.

To help us even more can you post the wband the mdb.

Attachment 8105

Xld -

Again - Thanks!

I'm working on the .mdb zip

Here is the .mdb zip.

Attachment 8106

Can you give me a list of values to plug in, and what you want to see where please?

Xld -

1 On UF start up click "Work Order" button
2 The Multipage should show. Select "Open Work Order" page
3 CB1 - L6
4 CB2 - KP
5 CB3 - MOA108
6 TB1(Qty) - 500
7 TB4(W/O #) 999999 - tab out
You will see the userform.spreadsheet control show filled. This is writing the data to the activework book sheet then copying/pasteing to the UF Spreadsheet control. Can I have the Spreadsheet control updated without the Copy/Paste. Updated directly via code. This is currently being done in the Public Sub CleanupFill

Well - I've finally figured this out. I would like to see if someone could make this better, but it works for now.

Points of interest -
In the first ADO - in order to get the count of records in your database - you need to adOpenStatic or it error's out.

If you have your spreadsheet1 hide the code will error out. You must unhide prior to filling it in.
Me.oSpreadsheet1.Visible = True

I wanted my .mdb column names as my spreadsheets top row so you need to use Field Names.

Code:

---

Private Sub SpreadsheetFill()
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim MySQLcheck As String
    Dim i, j As Long
    Dim FieldCount, RowCount As Integer
    Set rst = New ADODB.Recordset
    Set cnn = New ADODB.Connection
    MySQLcheck = "Select * from XXXFG_Leadtime"
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=F:\Open Projects\Sunkist.mdb;"
        .Open
    End With
       
    rst.Open MySQLcheck, cnn, adOpenStatic
    RowCount = (rst.RecordCount)
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing

    Set cnn = New ADODB.Connection
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=F:\Open Projects\Sunkist.mdb"
MySQLcheck = "SELECT [WH_From],[WH_To],[Total_Days_Req],[To_Schedule],[Production_Days],[QA_Incubation],[Load_Time],[On_Water],[Truck_To_Whse] from XXXFG_Leadtime where [WH_From] = '" & UF_WorkOrder.MultiPage1(1).oCB1.Value & "' AND [WH_To] = '" & UF_WorkOrder.MultiPage1(1).oCB2.Value & "';"
    Set rst = cnn.Execute(MySQLcheck)
    FieldCount = (rst.Fields.Count)
rst.MoveFirst
Me.oSpreadsheet1.Visible = True
Me.oSpreadsheet1.SetFocus
For i = 0 To FieldCount - 1
    With Me.oSpreadsheet1.Cells(1, 1).Offset(0, i)
        .Value = rst.Fields(i).Name
    End With
Next i
rst.MoveFirst
For j = 0 To RowCount - RowCount  '(This will return a single record.  Replace -RowCount with -1 if you have more than 1 record)
For i = 0 To FieldCount - 1
With Me.oSpreadsheet1.Cells(j + 2, 1).Offset(0, i)
.Value = rst.Fields(i).Value
End With
Next i
rst.MoveNext
Next j
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
End Sub

---