Follow @dporton

JustCode : Updated Functions for GetMrData.xls

This update getdata function will split the data across multiple tabs.

Sub GetData()

'variables used to invoke the standard MS Data Link Properties dialog
Dim DataLinkHelper

'variables used to access ADO
Dim ADO
Dim SQLQuery
Dim RecordSet
Dim Field

'variables used to populate Excel cells
Dim XLSheet
Dim XLStartRow
Dim XLStartColumn
Dim XLCol
Dim XLRow
Dim iFieldsPerSheet
Dim oSheet

'have the user specify the data source they wish to use
Set DataLinkHelper = CreateObject("MROLEDB.DataLinkHelper")
Result = DataLinkHelper.DisplayWizard() 'this will return the connection string
If Result = "" Then 'User Canceled
      Call MsgBox("Data source selection canceled by user.")
      Exit Sub
Else 'instantiate an ADO object and give it the connection string returned by the Data Link Properties dialog
     Set ADO = CreateObject("ADODB.Connection")
     ADO.ConnectionString = Result
     ADO.Open
End If

'execute a query that will return all the data
'from the data source specfied by the user
SQLQuery = "select * from vdata"
Set RecordSet = ADO.Execute(SQLQuery)

'now iterate thru the returned recordset to populate the Excel worksheet
XLSheet = 1
XLStartRow = 5
XLStartColumn = 1
For Each oSheet In Worksheets
    Worksheets(XLSheet).Cells.ClearContents
    XLSheet = XLSheet + 1
Next

XLCol = XLStartColumn
XLRow = XLStartRow
iFieldsPerSheet = 10
XLSheet = 1

For Each Field In RecordSet.Fields
    Worksheets(XLSheet).Cells(XLRow, XLCol).FormulaR1C1 = Field.Name
    XLCol = XLCol + 1
    If (iFieldsPerSheet < XLCol) Then
        XLCol = XLStartColumn
        XLSheet = XLSheet + 1
        If (Sheets.Count < XLSheet) Then
            Sheets.Add After:=Sheets(Sheets.Count)
        End If
    End If
Next

If Not RecordSet.EOF Then
    XLRow = XLStartRow + 1
    Do Until RecordSet.EOF
        XLCol = XLStartColumn
        XLSheet = 1
        For Each Field In RecordSet.Fields
            Worksheets(XLSheet).Cells(XLRow, XLCol).FormulaR1C1 = RecordSet(Field.Name)
            XLCol = XLCol + 1
            If (iFieldsPerSheet < XLCol) Then
                XLCol = XLStartColumn
                XLSheet = XLSheet + 1
                If (Sheets.Count < XLSheet) Then
                    Sheets.Add After:=Sheets(Sheets.Count)
                End If
           End If
       Next
      XLRow = XLRow + 1
      RecordSet.MoveNext
      DoEvents
    Loop
End If
ADO.Close

End Sub

Leave a Comment

%d bloggers like this: