VBA Excel - Carregando uma Matriz com um Recordset

VBA Excel - Carregando uma Matriz com um Recordset

É possível transferir o conteúdo de um conjunto de registros ADO para uma planilha pela automação do MS Excel. A abordagem que pode ser usada depende da versão do MS Excel que estiver automatizando. O MS Excel 97, o MS Excel 2000 e o MS Excel 2002 têm um método CopyFromRecordset que pode ser usado para transferir um conjunto de registros para um intervalo. O CopyFromRecordset no MS Excel 2000 e 2002 pode ser usado para copiar um conjunto de registros DAO ou ADO. Porém, o CopyFromRecordset no MS Excel 97 suporta apenas conjuntos de registros DAO. Para transferir um conjunto de registros ADO para o MS Excel 97, é possível criar uma matriz a partir do conjunto de registros e preencher um intervalo com o conteúdo da matriz.

Como carregar uma Matriz com o retorno de um recordset?

Super útil e bem prático...Usem!

Sub rs2Matrix()

    Dim v As Variant

    Dim l1 As Long

    Dim l2 As Long

    
    Let nMatrix = SQL("SELECT Nome, Idade FROM [Plan1$]")

    For l1 = LBound(nMatrix, 1) To UBound(nMatrix, 1)

        For l2 = LBound(nMatrix, 2) To UBound(nMatrix, 2)

            Debug.Print nMatrix (l1, l2)

        Next l2

    Next l1

End Sub

Function nSQL (sSQL As String) As Variant

    'Referenciar 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


O código de exemplo fornecido abaixo mostra como copiar um conjunto de registros ADO em uma planilha do Microsoft Excel usando a automação do Microsoft Visual Basic. Primeiro, o código verifica a versão do  Microsoft Excel. Se o Excel 2000 ou  Excel 2002 for detectado, o método CopyFromRecordset será usado pois é eficiente e solicita menos código. Entretanto, se o   Microsoft Excel 97  ou versão anterior for detectado, o conjunto de registros será copiado primeiro em uma matriz usando o método GetRows do objeto do conjunto de registros ADO. A matriz é então transposta de modo que os registros estejam na primeira dimensão (em linhas), e os campos estejam na segunda dimensão (em colunas). Em seguida, a matriz é copiada em uma planilha do  Microsoft Excel ao atribuí-la a um intervalo de células. (A matriz é copiada em uma etapa, em vez de fazer loops em cada célula na planilha.)

O exemplo do código usa o banco de dados de exemplo da Northwind incluído no Microsoft Office. Se você selecionou a pasta padrão ao instalar o Microsoft Office, o banco de dados estará localizado em:

\Program Files\Microsoft Office\Office\Samples\Northwind.mdb 

Se o banco de dados Northwind estiver localizado em uma pasta diferente no seu computador, será necessário editar o caminho do banco de dados no código fornecido abaixo.

Se você não tiver o banco de dados Northwind instalado no seu sistema, será possível usar a opção Adicionar/Remover para que a configuração do Microsoft Office instale os bancos de dados de exemplo. O banco de dados Northwind não é instalado ao instalar o Microsoft Office 2007

Adicione uma referência à Biblioteca do Microsoft ActiveX Data Objects 2.1.


Private Sub Command1_Click()      
Dim cnt As New ADODB.Connection      
Dim rst As New ADODB.Recordset      
Dim xlApp As Object      
Dim xlWb As Object      
Dim xlWs As Object      
Dim recArray As Variant      
Dim strDB As String      
Dim fldCount As Integer      
Dim recCount As Long      
Dim iCol As Integer      
Dim iRow As Integer            ' Set the string to the path of your Northwind database      

strDB ="c:\program files\Microsoft office\office11\samples\Northwind.mdb"          ' Open connection to the database      

cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & strDB & ";"            

''When using the Access 2007 Northwind database      
''comment the previous code and uncomment the following code.      
'cnt.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _      
'    "Data Source=" & strDB & ";"                
' Open recordset based on Orders table      
rst.Open "Select * From Orders", cnt        
    
' Create an instance of Excel and add a workbook      
Set xlApp = CreateObject("Excel.Application")      
Set xlWb = xlApp.Workbooks.Add      
Set xlWs = xlWb.Worksheets("Sheet1")          ' Display Excel and give user control of Excel's lifetime      
xlApp.Visible = True      
xlApp.UserControl = True            ' Copy field names to the first row of the worksheet      
fldCount = rst.Fields.Count      

For iCol = 1 To fldCount          

xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name      

Next                ' Check version of Excel      

If Val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then          
'EXCEL 2000,2002,2003, or 2007: Use CopyFromRecordset                     
' Copy the recordset to the worksheet, starting in cell A2          
xlWs.Cells(2, 1).CopyFromRecordset rst          

'Note: CopyFromRecordset will fail if the recordset          
'contains an OLE object field or array data such          
'as hierarchical recordsets                

Else          'EXCEL 97 or earlier: Use GetRows then copy array to Excel                

' Copy recordset to an array          
recArray = rst.GetRows          

'Note: GetRows returns a 0-based array where the first          
'dimension contains fields and the second dimension          
'contains records. We will transpose this array so that          
'the first dimension contains records, allowing the          
'data to appears properly when copied to Excel                    
' Determine number of records            

recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array                      

' Check the array for contents that are not valid when          
' copying the array to an Excel worksheet          

For iCol = 0 To fldCount - 1              
For iRow = 0 To recCount - 1                  ' Take care of Date fields                  

If IsDate(recArray(iCol, iRow)) Then                      

recArray(iCol, iRow) = Format(recArray(iCol, iRow))                  ' Take care of OLE object fields or array fields                  

ElseIf IsArray(recArray(iCol, iRow)) Then                      

recArray(iCol, iRow) = "Array Field"                  

End If              

Next iRow 'next record          
Next iCol 'next field                        ' Transpose and Copy the array to the worksheet,          ' starting in cell A2          

xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _              TransposeDim(recArray)      

End If        ' Auto-fit the column widths and row heights      

xlApp.Selection.CurrentRegion.Columns.AutoFit      
xlApp.Selection.CurrentRegion.Rows.AutoFit        ' Close ADO objects      

rst.Close      
cnt.Close  

Set rst = Nothing      
Set cnt = Nothing            ' Release Excel references      
Set xlWs = Nothing      
Set xlWb = Nothing        
Set xlApp = Nothing  
End Sub      

Function TransposeDim(v As Variant) As Variant  
' Custom Function to Transpose a 0-based array (v)            
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


Usando o CopyFromRecordset

Para eficiência e desempenho, CopyFromRecordset é o método preferido. Como o Excel 97 suporta apenas conjuntos de registros DAO com o CopyFromRecordset, se você tentar transmitir um conjunto de registros ADO para o CopyFromRecordset com o Excel 97, a seguinte mensagem de erro será exibida:
Erro de tempo de execução 430:
A classe não suporta a Automação ou não suporta a interface esperada.
No exemplo de código, é possível evitar esse erro ao verificar a versão do Excel para não usar o CopyFromRecordset na versão 97.

Observação Ao usar o CopyFromRecordset, você deve estar ciente de que o conjunto de registros ADO ou DAO usado não pode conter campos objeto OLE ou dados de matriz, tais como conjuntos de registros hierárquicos. Se você incluir campos de ambos os tipos em um conjunto de registros, o método CopyFromRecordset irá falhar com o seguinte erro:
Erro de tempo de execução -2147467259:
Falha no método CopyFromRecordset do objeto Range.
Usando o método GetRows

Se o Excel 97 for detectado, use o método GetRows do conjunto de registros ADO para copiar o conjunto de registros em uma matriz. Se você atribuir a matriz retornada por GetRows a um intervalo de células na planilha, os dados irão para as colunas em vez de irem para as linhas. Por exemplo, se o conjunto de registros tiver dois campos e 10 linhas, a matriz será exibida como duas linhas e 10 colunas. Portanto, você precisa transpor a matriz usando a função TransposeDim() antes de atribuir a matriz ao intervalo de células. Ao atribuir uma matriz a um intervalo de células, existem algumas limitações a saber:

As limitações a seguir aplicam-se ao atribuir uma matriz a um objeto Range do Excel:
  • A matriz não pode conter campos objeto OLE ou dados de matriz, tais como conjuntos de registros hierárquicos. Observe que o exemplo de código verifica essa condição e exibe "Campo de Matriz" para que o usuário fique ciente de que o campo não pode ser exibido no Excel.
  • A matriz não pode conter campos Data que têm uma data anterior ao ano de 1900. (Consulte a seção "Referências" de um link da Base de Dados de Conhecimento Microsoft.) Observe que o exemplo de código formata os campos Data como seqüências variantes para evitar este possível problema.
Observe o uso da função TransposeDim() para transpor a matriz antes da matriz ser copiada para a planilha do Excel. Em vez de criar sua própria função para transpor a matriz, é possível usar a função Transpor do Excel modificando o código de exemplo para atribuir a matriz às células como exibido abaixo:

   xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _        xlApp.WorksheetFunction.Transpose(recArray)      
Se você decidir usar o método Transpor do Excel em vez da função TransposeDim() para transpor a matriz, você deverá estar ciente das seguintes limitações do método Transpor:
  • A matriz não pode conter um elemento maior que 255 caracteres.
  • A matriz não pode conter valor Nulo.
  • O número de elementos na matriz não pode exceder 5461.
Se as limitações acima não forem consideradas ao copiar uma matriz em uma planilha do Excel, um dos seguintes erros de tempo de execução poderá ocorrer:
Erro de tempo de execução 13: Tipo incompatível
Erro de tempo de execução 5: Argumento ou chamada de procedimento inválida
Erro de tempo de execução 1004: Erro definido por objeto ou definido por aplicativo

Reference::


Veja outros códigos:

VBA Excel | Extraindo a Data de uma Célula com Data e Horário - Remove Date from Date and Time VBA Excel | Converta Tudo para Maiúscula - Convert to Upper CaseVBA Excel | Contando Palavras na Planilha - Word Count from Entire Worksheet VBA Excel | Removendo Decimais dos Números - Remove Decimals from Numbers

VBA Excel |  Multiplique todos os Valores por um Número - Multiply all the Values by a Number VBA Excel | Calculando a Raiz Cúbica - Calculate the Cube Root

VBA Excel | Adicionando Letras de A até Z - Add A-Z Alphabets in a Range VBA Excel | Convertendo Numerais Romanos em Arábicos - Convert Roman Numbers into Arabic Numbers

VBA Excel | Converta todos os Números Negativos em Positivos - Remove Negative Signs VBA Excel | Preencha com zeros as Células em Branco - Replace Blank Cells with Zeros


 Série de Livros nut Project 

DONUT PROJECT: VBA - Projetos e Códigos de Visual Basic for Applications (Visual Basic For Apllication)eBook - DONUT PROJECT 2024 - Volume 03 - Funções Financeiras - André Luiz Bernardes eBook - DONUT PROJECT 2024 - Volume 02 - Conectando Banco de Dados - André Luiz Bernardes eBook - DONUT PROJECT 2024 - Volume 01 - André Luiz Bernardes




 Série VBA Outlook: 

VBA Outlook - Usando o VBA no Outlook - Using Visual Basic for Applications in Outlook - Usando o DAO em vez do ADO (Using DAO instead of ADO) VBA Outlook - Usando o VBA no Outlook - Using Visual Basic for Applications in Outlook - Usando um Recordset Desconectado (Using a Disconnected Recordset) VBA Outlook - Usando o VBA no Outlook - Using Visual Basic for Applications in Outlook - Usando Transações (Using Transactions)


VBA Outlook - Usando o VBA no Outlook - Using Visual Basic for Applications in Outlook - Usando Parâmetros em Consultas SQL (Using Parameters in SQL Queries) VBA Outlook - Usando o VBA no Outlook - Using Visual Basic for Applications in Outlook - Tratando Erros (Handling Errors) VBA Outlook - Usando o VBA no Outlook - Using Visual Basic for Applications in Outlook - Fechando a Conexão (Closing the Connection)


VBA Outlook - Usando o VBA no Outlook - Using Visual Basic for Applications in Outlook - Enviando um e-Mail para cada Cliente (Sending an email to each Customer) VBA Outlook - Usando o VBA no Outlook - Using Visual Basic for Applications in Outlook - Lendo Dados do Conjunto de Registros (Reading Recordset Data) VBA Outlook - Usando o VBA no Outlook - Using Visual Basic for Applications in Outlook - Executando uma Consulta SQL (Executing an SQL Query)


VBA Outlook - Usando o VBA no Outlook - Using Visual Basic for Applications in Outlook - Conectando ao Banco de Dados usando ADO (Connecting to the Database using ADO)


 Série DONUT PROJECT 2024 

DONUT PROJECT 2024 - VBA - Retorna o Valor do Conteúdo da Área de Transferência do Sistema DONUT PROJECT 2024 - VBA - Retorna a Versão do Sistema Operacional em que o Excel está sendo Executado DONUT PROJECT 2024 - VBA - Desenvolvimento de Ferramentas de Análise de Riscos

DONUT PROJECT 2024 - VBA - Desenvolvimento Obter Informações sobre a Versão do Sistema Operacional DONUT PROJECT 2024 - VBA - Automatizando Tarefas de Engenharia e Design DONUT PROJECT 2024 - VBA - Automatização de Processos de Medir Distâncias no Google Maps

DONUT PROJECT 2024 - VBA - Automatização de Processos de Marketing Mail com o GMail DONUT PROJECT 2024 - VBA - Automatização de Processos de Marketing Mail DONUT PROJECT 2024 - VBA - Como proteger e ocultar fórmulas em uma planilha do Excel usando VBA

DONUT PROJECT 2024 - VBA - Código Exporta os dados e Atualiza as Quantidades em Estoque de um Determinado Produto na Planilha "Estoque" Crie Funções Personalizadas com Visual Basic for Applications (VBA) para Análise de Dados nos Negócios Saber programar em Visual Basic for Applications (VBA)



 Série DONUT PROJECT 2021 


DONUT PROJECT 2021 - VBA Function: Sabe como enviar dados para o Google Sheet, através do MS Excel, usando VBA, no MacBook?

DONUT PROJECT 2021 - VBA Function:  Como Rastrear o Google Maps (Coordenadas Geográficas) no VBA Excel? DONUT PROJECT 2021 - VBA Function:  Crie Acrônimos a partir de Strings de Texto DONUT PROJECT 2021 - VBA Function:  Convertendo uma Matrix num Vetor - Convert Matrix to a Vector

DONUT PROJECT 2021 - VBA Function:  Como tornar o Formulário Transparente no MS Excel? DONUT PROJECT 2021 - VBA Function:  Faça Buscas no Google a Partir da Célula do MS Excel - Search Google From a Cell DONUT PROJECT 2021 - VBA Function:  Decompondo um Nome nas Dimensões de uma Matriz


DONUT PROJECT 2021 - VBA Function: Extraindo o Último Sobrenome de um Nome Completo ou a Última Palavra de uma Frase DONUT PROJECT 2021 - VBA Function:  Extraindo o Segundo Nome de um Nome Completo ou a Segunda Palavra de uma Frase DONUT PROJECT 2021 - VBA Function: Extraindo o Primeiro Nome ou  a Primeira Palavra de uma Frase



 Série DONUT PROJECT 2018 

DONUT PROJECT 2018 - VBA - 12 - Aumente sua Produtividade DONUT PROJECT 2018 - VBA - 10 - Loop For-Each DONUT PROJECT 2018 - VBA - 08 - Referenciando Ranges


DONUT PROJECT 2018 - VBA - 07 - Amostra de Macro  DONUT PROJECT 2018 - VBA - 06 - Recursos Adicionais DONUT PROJECT 2018 - VBA - 05 - Gravando a Primeira Macro

DONUT PROJECT 2018 - VBA - 04 - Opções de Solução DONUT PROJECT 2018 - VBA - 03 - Requisitos e Preparação DONUT PROJECT 2018 - VBA - 02 - Continua Cético

DONUT PROJECT 2018 - VBA - 01 - Maximizando Sua Eficiência DONUT PROJECT 2018 - Excel - Ao Gravar Macro Altere o Método SELECT por RANGE 


 DONUT PROJECT 2018 - Excel - Acelerando as Macros - Desativando os Recursos de Atualização



 Série DONUT PROJECT 2015 

DONUT PROJECT 2015 - Excel - Formatting A Pivot Field's Data - Formatando os Campos de uma Tabela Dinâmica DONUT PROJECT 2015 - Excel - Formatting A Pivot Table's Data - Formatando os Dados de um Tabela Dinâmica DONUT PROJECT 2015 - Excel - Expand/Collapse Entire Field Detail - Ampliando Detalhadamente os Campos da Tabela Dinâmica

DONUT PROJECT 2015 - Extraindo e-Mails - Extracting An Email Address From Text   DONUT PROJECT 2015 - Função - Extraindo Quaisquer Elementos de uma String a Partir do Limitador DONUT PROJECT 2015 - Função - Retorna o número de ocorrências de um caracter numa string

DONUT PROJECT 2015 - Função - Retorna Qualquer Conteúdo Delimitado por 2 Caracteres  DONUT PROJECT 2015 - Função - Retorna Apenas o Conteúdo Entre Parênteses DONUT PROJECT 2015 - Função - Extrai Conteúdo entre Parênteses

DONUT PROJECT 2015 - Excel - Report Layout DONUT PROJECT 2015 - Excel - Grand Totals - Inserindo Totais para todas as Colunas e Linhas na Tabela Dinâmica DONUT PROJECT 2015 - Excel - Change Pivot Table Data Source Range - Mudando a Fonte de Dados da Tabela Dinâmica

DONUT PROJECT 2015 - Excel - Refresh Pivot Tables - Aplicando Refresh em Tabelas Dinâmicas DONUT PROJECT 2015 - How To Create Partially Anonymous Data - Como Manter Informações parcialmente Anônimas  DONUT PROJECT 2015 - Excel - Clear Report Filter - Limpando o Filtro da Tabela Dinâmica

DONUT PROJECT 2015 - Excel - Report Filter On Multiple Items - Criando Filtros Múltiplos na Tabela Dinâmica DONUT PROJECT 2015 - Excel - Report Filter On A Single Item - Criando Filtro de Relatório na Tabela Dinâmica DONUT PROJECT 2015 - Excel - Remove Calculated Pivot Fields - Removendo Campos Calculados da Tabela Dinâmica

DONUT PROJECT 2015 - Excel - Remove Pivot Fields - Removendo Campos da Tabela Dinâmica  DONUT PROJECT 2015 - Excel - Add A Values Field - Adicionando Campos Calculados na Tabela Dinâmica DONUT PROJECT 2015 - Excel - Add Calculated Pivot Fields - Adicionando Campos Calculados na Tabela Dinâmica

DONUT PROJECT 2015 - Excel - Add Pivot Fields - Adicionado Campos na Tabela Dinâmica DONUT PROJECT 2015 - Excel - Delete All Pivot Tables - Apagando todas as Tabelas Dinâmicas DONUT PROJECT 2015 - Excel - Delete A Specific Pivot Table - Apague um Tabela Dinâmica Específica


DONUT PROJECT 2015 - VBA To Add A Confidentiality Footer Statement In Excel, Word, or PowerPoint - Adicionando um Rodapé com Status de Confidencialidade no Excel, Word ou PowerPoint DONUT PROJECT 2015 - Excel - Create A Pivot Table - Criando uma Tabela Dinâmica


 Série DONUT PROJECT 2014 

DONUT PROJECT 2014 - Use os add-ins do MS Excel e dê um salto em sua performance DONUT PROJECT 2014 - VBA - Automatizando o Outlook para enviar um e-mail com anexo  DONUT PROJECT 2014 - VBA - Outlook - Salvando todos os arquivos anexados nos e-mails


DONUT PROJECT 2014 - VBA - Criando uma Matriz de Datas MAT - Moving Annual Total  DONUT PROJECT 2014 - VBA - Excel - Atualizando Tabelas Dinâmicas - Refresh Pivot Table via VBA DONUT PROJECT 2014 - VBA - Excel - Removendo os Caracteres Alfabéticos e Especiais


DONUT PROJECT 2014 - VBA - Access - Criando uma Query com Parâmetros DONUT PROJECT 2014 - VBA - Access - Atualizando o conteúdo de uma Query DONUT PROJECT 2014 - VBA - Access - Saiba o Número de Registro de cada tabela


DONUT PROJECT 2014 - VBA - Access - Extraia Blocos de Dados do Banco de Dados - Sem Problemas de TIMEOUT DONUT PROJECT 2014 - VBA - Access - Lista o Tamanho de Todas as Tabelas DONUT PROJECT 2014 - VBA - Excel - Populando um ListBox no seu Formulário

DONUT PROJECT 2014 - VBA - Excel - Importando arquivos CSV  DONUT PROJECT 2014 - VBA - Excel - Deletando Conexões de Dados  DONUT PROJECT 2014 - VBA - Excel - Obtendo o Nome da Planilha sem a Extensão - Get name of workbook without extension


DONUT PROJECT 2014 - VBA - WORD - Exportação Automatizada - De *.docx Para *.pdf - Otimizando o tamanho


  Clique aqui e nos contate via What's App para avaliarmos seus projetos 

Envie seus comentários e sugestões e compartilhe este artigo!
brazilsalesforceeffectiveness@gmail.com

Inline image 1

Nenhum comentário:

Postar um comentário

diHITT - Notícias