É 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 VariantDim l1 As LongDim l2 As LongLet 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 l2Next l1End SubFunction nSQL (sSQL As String) As Variant'Referenciar biblioteca Microsoft ActiveX Objects 2.0 ou superiorDim cn As ADODB.ConnectionDim rs As ADODB.RecordsetSet cn = New ADODB.ConnectionSet rs = New ADODB.RecordsetSelect Case Val(Application.Version)Case 8, 9, 10, 11cn.ConnectionString = _"Provider=Microsoft.Jet.OLEDB.4.0;" & _"Data Source=" & ThisWorkbook.FullName & ";" & _"Extended Properties=Excel 8.0"Case 12, 14cn.ConnectionString = _"Provider=Microsoft.ACE.OLEDB.12.0;" & _"Data Source=" & ThisWorkbook.FullName & ";" & _"Extended Properties=Excel 8.0"End Selectcn.OpenSet rs = cn.Execute(sSQL)SQL = rs.GetRowsrs.Closecn.CloseEnd 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.ConnectionDim rst As New ADODB.RecordsetDim xlApp As ObjectDim xlWb As ObjectDim xlWs As ObjectDim recArray As VariantDim strDB As StringDim fldCount As IntegerDim recCount As LongDim iCol As IntegerDim iRow As Integer ' Set the string to the path of your Northwind databasestrDB ="c:\program files\Microsoft office\office11\samples\Northwind.mdb" ' Open connection to the databasecnt.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 tablerst.Open "Select * From Orders", cnt' Create an instance of Excel and add a workbookSet xlApp = CreateObject("Excel.Application")Set xlWb = xlApp.Workbooks.AddSet xlWs = xlWb.Worksheets("Sheet1") ' Display Excel and give user control of Excel's lifetimexlApp.Visible = TruexlApp.UserControl = True ' Copy field names to the first row of the worksheetfldCount = rst.Fields.CountFor iCol = 1 To fldCountxlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).NameNext ' Check version of ExcelIf 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 A2xlWs.Cells(2, 1).CopyFromRecordset rst'Note: CopyFromRecordset will fail if the recordset'contains an OLE object field or array data such'as hierarchical recordsetsElse 'EXCEL 97 or earlier: Use GetRows then copy array to Excel' Copy recordset to an arrayrecArray = 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 recordsrecCount = 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 worksheetFor iCol = 0 To fldCount - 1For iRow = 0 To recCount - 1 ' Take care of Date fieldsIf IsDate(recArray(iCol, iRow)) ThenrecArray(iCol, iRow) = Format(recArray(iCol, iRow)) ' Take care of OLE object fields or array fieldsElseIf IsArray(recArray(iCol, iRow)) ThenrecArray(iCol, iRow) = "Array Field"End IfNext iRow 'next recordNext iCol 'next field ' Transpose and Copy the array to the worksheet, ' starting in cell A2xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _ TransposeDim(recArray)End If ' Auto-fit the column widths and row heightsxlApp.Selection.CurrentRegion.Columns.AutoFitxlApp.Selection.CurrentRegion.Rows.AutoFit ' Close ADO objectsrst.Closecnt.CloseSet rst = NothingSet cnt = Nothing ' Release Excel referencesSet xlWs = NothingSet xlWb = NothingSet 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 LongDim tempArray As VariantXupper = UBound(v, 2)Yupper = UBound(v, 1)ReDim tempArray(Xupper, Yupper)For X = 0 To XupperFor Y = 0 To YuppertempArray(X, Y) = v(Y, X)Next YNext XTransposeDim = 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:
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:
Leia também:
Conheça também:
Série Piece of Cake
- PIECE OF CAKE - MS Excel - Zipando - Compacte no formato Zip
- PIECE OF CAKE - MS Excel - Zipando - Escolha os Arquivos a Compactar
- PIECE OF CAKE - MS Excel - Zipando - Escolha uma Pasta e Compacte
- PIECE OF CAKE - MS Excel - Zipando - Compacte Todos os Arquivos da Pasta
- PIECE OF CAKE - MS Excel - Zipando - Compacte a Planilha Atual
- PIECE OF CAKE - MS Excel - Zipando - Compacte e Envie por e-Mail
- PIECE OF CAKE - Connecting to Oracle 12g with Excel VBA
- PIECE OF CAKE - Extract Path From String
- PIECE OF CAKE - Detecta se Arquivo Existe
- PIECE OF CAKE - MS Excel - Finding Last Row
- PIECE OF CAKE - Obtendo Endereço IP
- PIECE OF CAKE - Criando Arquivo Texto Externo
- PIECE OF CAKE - Criando Tabelas no SQL Server a partir do MS Excel
- PIECE OF CAKE - Notação Húngara
- PIECE OF CAKE - Usando Stored Procedures
- PIECE OF CAKE - Microsoft Access - Removendo Prefixo das Tabelas
- PIECE OF CAKE - MS Access e MS Word - Técnica de Automação
- PIECE OF CAKE - MS Access - 5 Formas Manuais de Reparo
- PIECE OF CAKE - Correção de Métricas
- PIECE OF CAKE - Convertendo Texto em Imagem
- PIECE OF CAKE - Excel - Manipule o Google Maps em sua Planilha
- PIECE OF CAKE - VBA Excel - Traduzindo Planilhas - Google Translate API
- PIECE OF CAKE - Defina a Latitude e a Longitude
Séries Donut
- DONUT PROJECT 2018 - VBA - 12 - Aumente sua Produtividade
- DONUT PROJECT 2018 - VBA - 11 - Os Benefícios do Controle de Versão
- DONUT PROJECT 2018 - VBA - 10 - Loop For-Each
- DONUT PROJECT 2018 - VBA - 09 - Método Count
- 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 - Gravando Macro Altere SELECT por RANGE
- DONUT PROJECT 2018 - O que Desenvolvedores Aprendem com Michael Jordan
- DONUT PROJECT 2018 - Excel - Macros - Mudando o Mindset
- DONUT PROJECT 2018 - Excel - Acelerando Macros
- DONUT PROJECT 2015 - Extraindo e-Mails
- DONUT PROJECT 2015 - Função - Extraindo Elementos da String
- DONUT PROJECT 2015 - Função - Retornando Nº de ocorrências de um Caractere
- DONUT PROJECT 2015 - Função - Retorna 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 na Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Mudando a Fonte de Dados da Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Aplicando Refresh em Tabelas Dinâmicas
- DONUT PROJECT 2015 - Como Manter Informações parcialmente Anônimas
- DONUT PROJECT 2015 - Excel - Limpando o Filtro da Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Criando Filtros Múltiplos na Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Criando Filtro de Relatório na Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Remover Campos Calculados da Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Remover Campos da Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Adicionar Campos Calculados na Tabela Dinâmica
- DONUT PROJECT 2015 - Excel - Apagar todas as Tabelas Dinâmicas
- DONUT PROJECT 2015 - Excel - Apagar Tabela Dinâmica Específica
- DONUT PROJECT 2015 - Adicionar Rodapé de Confidencialidade no Office
- DONUT PROJECT 2015 - Excel - Criando uma Tabela Dinâmica
- DONUT PROJECT - Use os add-ins do MS Excel e dê um salto em sua performance
- DONUT PROJECT - VBA - Automatize o Outlook para enviar um e-mail com anexo
- DONUT PROJECT - VBA - Outlook - Salvando arquivos anexados nos e-mails
- DONUT PROJECT - VBA - Criando uma Matriz de Datas MAT - Moving Annual Total
- DONUT PROJECT - VBA - Excel - Atualize Tabelas Dinâmicas
- DONUT PROJECT - 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 - VBA - Access - Saiba o Número de Registro de cada tabela
- DONUT PROJECT - VBA - Access - Extraia Dados sem Problemas de TIMEOUT
- DONUT PROJECT - VBA - Access - Lista o Tamanho de Todas as Tabelas
- DONUT PROJECT - VBA - Excel - Populando um ListBox no seu Formulário
- DONUT PROJECT - VBA - Excel - Importando arquivos CSV
- DONUT PROJECT - VBA - Excel - Deletando Conexões de Dados
- DONUT PROJECT - VBA - Excel - Obtendo o Nome da Planilha sem a Extensão
- DONUT PROJECT - VBA - WORD - Exportação Automatizada - DOC para PDF
Comente e compartilhe este artigo!
brazilsalesforceeffectiveness@gmail.com
Nenhum comentário:
Postar um comentário