Carregar um Array com um Recordset no VBA EXCEL

Question

Senhores Experts,

Preciso carregar um array com o retorno de um recordset, mas não estou conseguindo de jeito nenhum, sempre recebo o retorno de que o número de campos do recordset é -1 e não consigo extrair nada dele. O Interessante é que se eu mando copiar pra uma planilha do excel funciona, ou seja, ele consegue retorno do banco normalmente.

O código que estou utilizando é o seguinte:

Private Sub cmb_buscarelacao_Click()

Dim objMyConn As ADODB.Connection
Dim objMyCmd As ADODB.Command
Dim rst As ADODB.Recordset
Dim Sstring As String
Dim ServerName As String
Dim VaData() As Variant
Dim row As Long, col As Long
Dim fd As Field
Dim oSql As String

'***************************************************************************************************
oSql = ""
oSql = oSql & "  SELECT [Ope_ID] "
oSql = oSql & "        ,convert(VARCHAR,[Data],103) AS DATA "
oSql = oSql & "        ,Cliente.CNPJ_CIC "
oSql = oSql & "        ,Cliente.Razao "
oSql = oSql & "        ,[Qtde] "
oSql = oSql & "        ,[Taxa] "
oSql = oSql & "        ,[CodMoeda] "
oSql = oSql & "        ,Vendas.[CodFilial] "
oSql = oSql & "        ,Vendas.[CodUsuario] "
oSql = oSql & "        ,[formaentr] "
oSql = oSql & "        ,[fpagto] "
oSql = oSql & "        ,[obs1] "
oSql = oSql & "        ,[obs2] "
oSql = oSql & "        ,[obs3] "
oSql = oSql & "        ,Cliente.[FisJur] "
oSql = oSql & "    FROM [th1014208_db].[dbo].[Vendas] left join Cliente on Vendas.CodCliente=Cliente.CodCliente "
oSql = oSql & "  where Data between '" & Format(dtpk_buscade, "YYYY-MM-DD") & "' and '" & Format(dtpk_buscaate, "YYYY-MM-DD") & "'"
oSql = oSql & "  and  Vendas.CodFilial='056' "
oSql = oSql & "  and CodMoeda like 'SC%' "

'***************************************************************************************************

     Set objMyConn = New ADODB.Connection
        Set objMyCmd = New ADODB.Command
        Set rst = New ADODB.Recordset

Sstring = "Provider=SQLOLEDB; Data Source=XXXXX;INITIAL CATALOG=XXXXX;User ID=XXXXXX;Password=XXXXXX;Trusted_Connection=sspi"

    'Open Connection'
        objMyConn.ConnectionString = Sstring
        objMyConn.Open

    'Set and Excecute SQL Command'
        Set objMyCmd.ActiveConnection = objMyConn
        objMyCmd.CommandText = oSql
        objMyCmd.CommandType = adCmdText
        objMyCmd.Execute

    'Open Recordset'
        Set rst.ActiveConnection = objMyConn
        rst.Open objMyCmd

'Sheets(3).Cells(2, 1).CopyFromRecordset rst

rst.MoveLast
ReDim SomeArray(rst.RecordCount - 1, rst.Fields.Count - 1)
'Neste ponto a propriedade RecordCount do objeto rst sempre me retorna -1

With rst
i = .Fields.Count
j = .RecordCount
End With
rst.MoveFirst
'Transfer the recordset to the array of variant-type.
VaData = rst.GetRows()

'Testing purpose only
'Debug.Print UBound(rst) + 1 'Due to 0-based array
'Debug.Print LBound(rst) + 1 'Due to 0-based array
'
'Debug.Print "Number of fields = " & i
'Debug.Print "Number of records = " & j

'Disconnect and empty memory.
rst.Close
Set rst = Nothing
cnn.Close
Set cnt = Nothing
oSql = ""

End Sub

Answer 1

Diego

vou movr sua thread para o forum de VB...

---

Att.
Marcelo Fernandes

MCP, MCDBA, MCSA, MCTS.
Se útil, classifique!!!
Me siga no twitter: @marcelodba

Answer 2

Olá,

Experimente trocar

Dim VaData() As Variant

por:

Dim VaData As Variant

E também remova a linha:

ReDim SomeArray(rst.RecordCount - 1, rst.Fields.Count - 1)

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 3

Benzadeus, infelizmente não funcionou.

Uma vez eu vi um código que funciou, mas não me lembro direito o que foi feito diferente, acredito que tenha ligação com o método de retorno da query do servidor, se não me engano o cara usava algo diferente do recordset.

Answer 4

Uma vez que o método CopyFromRecordset funciona, a informação está no RecordSet.

Veja o exemplo a seguir: https://skydrive.live.com/redir.aspx?cid=fb206a2d510e0661&resid=FB206A2D510E0661!343&parid=FB206A2D510E0661!275&authkey=!AMyB3uN4gTw-cY4

Código:

Sub RecordSet2Variant()
    Dim v As Variant
    
    Dim l1 As Long
    Dim l2 As Long
    
    v = SQL("SELECT Nome, Idade FROM [Plan1$]")
    For l1 = LBound(v, 1) To UBound(v, 1)
        For l2 = LBound(v, 2) To UBound(v, 2)
            Debug.Print v(l1, l2)
        Next l2
    Next l1
End Sub

Function SQL(sSQL As String) As Variant
    'Necessita de referência à biblioteca Microsoft ActiveX Objects 2.0 ou superior
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    
    Select Case Val(Application.Version)
        Case 8, 9, 10, 11
            cn.ConnectionString = _
              "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & ThisWorkbook.FullName & ";" & _
              "Extended Properties=Excel 8.0"
        Case 12, 14
            cn.ConnectionString = _
              "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & ThisWorkbook.FullName & ";" & _
              "Extended Properties=Excel 8.0"
    End Select
    cn.Open
    
    Set rs = cn.Execute(sSQL)
    SQL = rs.GetRows
    
    rs.Close
    cn.Close
End Function

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br