Running a MSQuery in Excel using VBA... 1

[doneitagain]

I am trying to run a MSQuery using VBA code in Excel 2000.

I use the query to access our informix database and return data into Excel.
I need to run the query in a for/next loop to return data based on a range of cells. The data returned is then copied to the appropriate cells in the worksheet and the process continues with the query rerun with the next cell value as the parameter.

I can't find info anywhere. Please help ....

Thanks in advance...

 

[SkipVought]

Hi,
MSQuery has had some severe problems in the past (like missing blocks of data).

I have been using DAO or ADO Objects to retrieve data from various relations databases. For doing the kind of thing that you want to do, I prefer DAO. I can assign the resultset to an array, and from there write the data to a sheet(s) since sometimes my total results are greater than 65,536 rows.

So, here's some skeleton code using an ODBC driver...

    DBEngine.DefaultType = dbUseODBC        'sets the next workspace for ODBC driver

    Set dbs = DBEngine.Workspaces(0).OpenDatabase(Name:="", ReadOnly:=True, Connect:="")

   For...

        sQuery = "select * from database"

        Set rst = dbs.OpenRecordset(Name:=sQuery, Type:=dbOpenSnapshot)
        If Err.Number > 0 Then
            vErr = Err.Number
            rst.Close
            GoTo NextRecord
        End If
    
    ' select on the recordset object
        With rst
            .MoveLast
            .MoveFirst
            lRecordCount = rst.RecordCount
        If lRecordCount > 0 Then
            vResults = Empty
            vResults = .GetRows(lRecordCount)
' The table is assumed to have the first column of data in Column A.
' However, the Header Row need not start in Row 1.
' HeaderRow is a function that returns the row number of the header row using the above stated assumptions.
            lHeadRow = HeaderRow
            lRowCount = Cells(lHeadRow, 1).CurrentRegion.Rows.Count
' This logic assumes that if the RowCount = 1 that there are no Headings
            If lRowCount = 1 Then
               iCol = 1
               For Each fld In .Fields
                  Cells(lHeadRow, iCol).Value = fld.Name
                  iCol = iCol + 1
               Next fld
            End If
        
' Results is a 2-dimension array
            On Error Resume Next
            For i = 0 To UBound(vResults, 2)
               For j = 0 To UBound(vResults, 1)
                  Cells(i + lHeadRow + lRowCount, j + 1).Select
                    With Selection
'                        .Value = "'" & vResults(j, i)
                    If IsNumeric(vResults(j, i)) Then
                       nValue = vResults(j, i)
                      .Value = nValue
                    Else
                       sValue = vResults(j, i)
                       .Value = sValue
                    End If
                  End With
               Next j
            Next i
            On Error GoTo 0
        End If
        End With
NextRecord:
    Next

Hope this helps Skip,
metzgsk@voughtaircraft.com