none
Carregar um Array com um Recordset no VBA EXCEL RRS feed

  • Pergunta

  • 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

    sexta-feira, 20 de abril de 2012 20:16

Respostas

  • 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

    domingo, 22 de abril de 2012 02:05
    Moderador

Todas as Respostas

  • 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

    sexta-feira, 20 de abril de 2012 20:42
  • 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

    sábado, 21 de abril de 2012 10:33
    Moderador
  • 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.

    domingo, 22 de abril de 2012 00:04
  • 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

    domingo, 22 de abril de 2012 02:05
    Moderador