DONUT PROJECT - VBA - Access - Saiba o Número de Registro de cada tabela

DONUT PROJECT - VBA - Access - Saiba o Número de Registro de cada tabela

Saiba quantos registros foram gerados em suas Tabelas.

Sub Records()
    '      Author: André Bernardes
    '        Date: 28/07/14 - 12:35
    ' Application: *** SalesForce®

    Dim dbs As DAO.Database
    Dim tbf As TableDef

    Set dbs = CurrentDb
    Set tbf = dbs.CreateTableDef
    For Each tbf In dbs.TableDefs
        Debug.Print "Tabela " & tbf.Name & ", com " & Format(tbf.RecordCount, "###,###,###") & " registros." '&Chr(10)   'vbCrLf
    Next tbf
End Sub


DONUT PROJECT - VBA - Access - Extraia Blocos de dados do Banco de dados - sem problemas de TIMEOUT

DONUT PROJECT - VBA - Access - Extraia Blocos de dados do Banco de dados - sem problemas de TIMEOUT


Podemos analisar grandes blocos de dados, 'fatiando-os' e consolidando-os se precisarmos, para análises pontuais, relatórios ou mesmo distribuição junto com as nossas planilhas Excel ou apresentações Powerpoint com os nossos Dashboards ou Scorecards.

Este código e técnica lhe permitirá extrair automaticamente blocos de informações de grandes bases de dados, além de lhe ensinar como passar o conteúdo de um campo como parâmetro para criar as tabelas de análise.

Este modelo de código foi desenvolvido de modo bem facilitado para ensinar aos iniciantes uma técnica acessível de extração de dados.

Tudo começa com o script SQL, copiado a partir do construtor do MS Access. Depois de definir no modo design todos os campos que deseja, bem como as consolidações, etc...Basta copiá-lo para o código abaixo, colocando-o na variável nSQL.

Esse código é extremamente versátil pois permite que você crie a query no MS Access, destruindo-a em seguida, e automaticamente elimina um problema muito comum para os menos experientes: Atribuir à query a característica de poder ficar conectada à view do SQL o tempo que for necessário sem que a conexão dê problemas de TIMEOUT.

Como este código pode ser adaptado a qualquer banco de dados MS Access, o código também higieniza a nossa base limpando-a das queries criadas para a geração das tabelas. 

Function GeraBases_Por_Region()
    '      Author: André Bernardes
    '        Date: 25/07/14 - 10:30
    ' AppliCategoryion: *** SalesForce®

    Dim nSQL As String
    Dim nQuery As String
    Dim i As Integer
    Dim nRegion As String
    Dim db_Q As QueryDef

    ' Cria uma tabela atualizada para cada Local.
    For i = 1 To 6  'Nº de Locais.
        Debug.Print i
        
        Let nRegion = Trim(Str(i))                        'Nº de Locais
        Let nSQL = "SELECT SQLServer_View_BIGDATA_Relatorio_LAB.OBSERVE_MYLAB, SQLServer_View_BIGDATA_Relatorio_LAB.Category_CT, SQLServer_View_BIGDATA_Relatorio_LAB.STATUS, SQLServer_View_BIGDATA_Relatorio_LAB.AREA, SQLServer_View_BIGDATA_Relatorio_LAB.BRAND AS Product, Left([DEPTO],2) AS Region, Left([DEPTO],3) AS DISTRICT, SQLServer_View_BIGDATA_Relatorio_LAB.DEPTO, SQLServer_View_BIGDATA_Relatorio_LAB.ID, SQLServer_View_BIGDATA_Relatorio_LAB.PROFILE, SQLServer_View_BIGDATA_Relatorio_LAB.CLIENT, SQLServer_View_BIGDATA_Relatorio_LAB.Citie, SQLServer_View_BIGDATA_Relatorio_LAB.FMonth AS PX00, SQLServer_View_BIGDATA_Relatorio_LAB.SMonth AS PX01, SQLServer_View_BIGDATA_Relatorio_LAB.TRI_00, SQLServer_View_BIGDATA_Relatorio_LAB.TRI_03, SQLServer_View_BIGDATA_Relatorio_LAB.SEMF_00, SQLServer_View_BIGDATA_Relatorio_LAB.SEMF_01, SQLServer_View_BIGDATA_Relatorio_LAB.MAT_00 " & _
                   "INTO tbl_tmp_B" & nRegion & "_PX " & _
                   "FROM SQLServer_View_BIGDATA_Relatorio_LAB " & _
                   "GROUP BY SQLServer_View_BIGDATA_Relatorio_LAB.OBSERVE_MYLAB, SQLServer_View_BIGDATA_Relatorio_LAB.Category_CT, SQLServer_View_BIGDATA_Relatorio_LAB.STATUS, SQLServer_View_BIGDATA_Relatorio_LAB.AREA, SQLServer_View_BIGDATA_Relatorio_LAB.BRAND, Left([DEPTO],2), Left([DEPTO],3), SQLServer_View_BIGDATA_Relatorio_LAB.DEPTO, SQLServer_View_BIGDATA_Relatorio_LAB.ID, SQLServer_View_BIGDATA_Relatorio_LAB.PROFILE, SQLServer_View_BIGDATA_Relatorio_LAB.CLIENT, SQLServer_View_BIGDATA_Relatorio_LAB.Citie, SQLServer_View_BIGDATA_Relatorio_LAB.FMonth, SQLServer_View_BIGDATA_Relatorio_LAB.SMonth, SQLServer_View_BIGDATA_Relatorio_LAB.TRI_00, SQLServer_View_BIGDATA_Relatorio_LAB.TRI_03, SQLServer_View_BIGDATA_Relatorio_LAB.SEMF_00, SQLServer_View_BIGDATA_Relatorio_LAB.SEMF_01, SQLServer_View_BIGDATA_Relatorio_LAB.MAT_00 " & _
                   "HAVING (((Left([DEPTO],2))='B" & nRegion & "'))"
        
        DoCmd.SetWarnings (False)
        
        ' Cria a query.
        Let nQuery = "qry_tmp_" & nRegion & "_Region"   ' Nome da query
        
        If Not IsNull(DLookup("Type", "MSYSObjects", "Name='nQuery'")) Then
            ' Deleta o objeto query.
            DoCmd.DeleteObject acQuery, nQuery
            
        Else
            CurrentDb.CreateQueryDef nQuery, nSQL
        End If

        ' Configura o timeout da query
        Set db_Q = CurrentDb.QueryDefs(nQuery)
        Let db_Q.ODBCTimeout = 0
        db_Q.Close

        ' Executa a query
        'DoCmd.RunSQL (nSQL)
        DoCmd.OpenQuery nQuery, acViewNormal, acEdit

        ' Deleta o objeto query.
        DoCmd.DeleteObject acQuery, nQuery

        DoCmd.SetWarnings (True)
    Next
    
    Set db_Q = Nothing
End Function



DONUT PROJECT - VBA - Access - Lista o Tamanho de Todas as Tabelas

DONUT PROJECT - VBA - Access - Lista o Tamanho de Todas as Tabelas


​Quando criamos tabelas vindas de outras bases de dados no MS Access. O resultado de views e análises, é importante que tenhamos uma ideia do seu tamanho.

Especialmente se formos conectá-las a planilhas com Dashboards.

O tamanho das tabelas fica registrado na área de debugação:



Sub Lista_Tamanho_Todas_Tabelas()
    '      Author: André Bernardes
    '        Date: 28/07/14 - 10:13
    ' Application: *** SalesForce®

  Dim dbs As DAO.Database
  Dim tdf As DAO.TableDef

  Dim strName As String
  Dim strFile As String
  Dim strPath As String
  Dim lngBase As Long
  Dim lngSize As Long
    
  On Error GoTo ListAllTables_Size_Error

  Set dbs = CurrentDb
  Let strName = dbs.Name
  Let strPath = Left(strName, Len(strName) - Len(Dir(strName)))
  
  ' Cria um database vazio para medir o tamanho do arquivo.
  Let strFile = strPath & "base" & ".mdt"
  CreateDatabase strFile, dbLangGeneral
  
  Let lngBase = FileLen(strFile)
  Kill strFile
  Debug.Print "Tamanho Base: ", lngBase

  For Each tdf In dbs.TableDefs
    Let strName = tdf.Name
    
    ' Appica um filtro para ignorar as tabelas internas de sistema do MS Access.
    If Left(strName, 4) <> "MSys" Then
      Let strFile = strPath & strName & ".mdt"
      
      Debug.Print strName, ;
      
      CreateDatabase strFile, dbLangGeneral
      
      DoCmd.TransferDatabase acExport, "Microsoft Access", strFile, acTable, strName, strName
      
      Let lngSize = FileLen(strFile) - lngBase
      Kill strFile
      Debug.Print lngSize
    End If
  Next
  
  Set tdf = Nothing
  Set dbs = Nothing

   On Error GoTo 0
   Exit Sub

ListAllTables_Size_Error:

    MsgBox "Erro: " & Err.Number & " (" & Err.Description & ") na SUB Lista_Tamanho_Todas_Tabelas."
End Sub


UM BREVE RETROSPECTO...




Bem, a minha primeira linguagem de programação foi o COBOL, passei pelo PascalC, e aprofundei-me mesmo no Clipper.

Já trabalhando, desenvolvi inúmeras aplicações com o Clipper para as diversas áreas de trabalho, uma vez que trabalhava em Santos, cidade portuária, com necessidades diversas. A empresa em que trabalhei, era uma softwarehouse, como chamávamos na época.

Desenvolvi sistemas de estocagem de café, venda|corretagem de café, contabilidade, estoque em geral, venda no balcão, etc...De software de Locadora de Videos a Controle de Condomínio, desenvolvi uma infinidade de aplicações e sistemas que foram ampliando-se com o passar do tempo e das necessidades dos Clientes, que já eram inúmeros.

A tecnologia também não parou, então venho conhecendo computadores de CP500 ao atual Ultrabook.

Vim de uma época onde o conceito Cliente/Servidor não existia, e precisávamos emulá-lo.

Enfim, casei-me e vim trabalhar no mercado de São Paulo numa consultoria. Como já tinha desenvolvido experiência para ter contato com diversos clientes, desenvolvendo inúmeras aplicações, pude destacar-me nesta empresa, que a princípio contratara-me apenas para desenvolver soluções internas.

Nesta ocasião, fui apresentado ao Delphi, uma linguagem visual, a minha primeira, apesar de já ter visto o Visual Basic e usado a versão Visual Objects do Clipper.

Em São Paulo pude ampliar meus conhecimentos e técnicas. Atendia variados clientes corporativos, nas áreas mais abrangentes possíveis, o que foi excelente!

Com o passar dos anos, além de programação e análise de sistemas, passei a focar-me em processos, liderar equipes, mas a paixão por desenvolver soluções rápidas e práticas não terminava, sempre dava um jeito para participar no desenvolvimento durante os projetos onde estava envolvido.

Pois bem, acabei percebendo um gap, lá pelos idos de 1997/8. As empresas, na sua totalidade, utilizavam massivamente o MS Office. O qual conhecia desde as primeiras versões, pois fora usuário dos famosos Lotus 123Visicalc, QuattroProWordstar, etc... Tive o insight de detectar que, apesar de muitos usuários terem acesso a este produto, o MS Office, bem poucos sabiam utilizá-lo plenamente. Não conheciam o conceito de Macros, e depois não captaram o momento onde a Microsoft trouxera o Visual Basic para dentro do MS Office.

Juntando a minha percepção e a necessidade do mercado, tive a ideia de me especializar em criar soluções única e exclusivamente com o MS Office. E isso envolvia usá-lo desde o MS Powerpoint, até o MS Access, e é óbvio que depois as tecnologias e a arquitetura em si, foram tornando-se ainda mais abrangentes.

Criei as aplicações mais diversas, em áreas ainda mais distintas que anteriormente. E poderá verificá-las através das minhas experiências profissionais, através das mais de 43 empresas por onde passei e estão constantes no meu curriculum vitae.

Pois bem, como não poderia deixar de ocorrer, findei por embrenhar-me em novos conceitos. Li muito, comprei muitos livros. Ministrei e assisti muitos cursos. E isso acabou me levando a manter em certo momento, uns 5 Blogs, onde escrevia sobre o desenvolvimento VBA e seus desdobramentos: 

Hoje, focado nos últimos 5 anos, na Indústria Farmacêutica, continuo usando os meus conhecimentos técnicos para desenvolver soluções na minha área de atuação.



DONUT PROJECT - VBA - Excel - Populando um ListBox no seu Formulário




Então, digamos que precise criar um pequeno script que permita que os seus usuários selecionem um número de colunas (letras de A a Z) a partir de um ListBox. E em seguida extraiamos os itens selecionados na caixa de listagem.

1
Crie um formulário com uma ListBox chamado Listbox1 e um botão chamado CommandButton1.


2
Crie uma SUB UserForms no seu formulário.



3
Preencha (popule) a ListBox com letras de A a Z:

Private Sub UserForm_Initialize()

' Crie um array.
Dim AlfabetArray() As String

' Defina o conteúdo do array. Aqui podemos separá-las com "|", mas não poderemos usar ",".
Let AlfabetArray = Split("A|B|C|D|E|F|G|H|I|J|K|L|M|N|O|P|Q|R|S|T|U|V|X|Y|Z", "|")

' Populando o Listbox com o array de letras
Let ListBox1.List = AlfabetArray

End Sub


4
Certifique-se de que a caixa de listagem tenha o seu atributo MultiSelect definido como 1 - fmMultiSelectMulti, se você quiser que os usuários possam selecionar vários itens com um clique do mouse.

Selecione 2 - fmMultiSelectExtended, se quiser que os usuários possam usar um  "Ctrl-clique " para selecionar vários itens muito mais rápido.



5
Extraia os itens selecionados do ListBox e insira-os na matriz para uso posterior.

Private Sub CommandButton1_Click()
Dim lItem As Long
Dim BernardNavne() As String    'Array
Dim blDimensioned As Boolean    'Is the array dimensioned?
Dim lngPosition As Long         'Counting
     
Let blDimensioned = False

' Efetua o Loop através de todos os itens no Listbox
For lItem = 0 To Me.ListBox1.ListCount - 1
         
        If Me.ListBox1.Selected(lItem) Then
        ' Se estiver selecionado adicionna-o ao array
        
            'Checamos se o array está corretamente dimensionado
            If blDimensioned = True Then
            ReDim Preserve BernardNavne(0 To UBound(BernardNavne) + 1) As String
            Else
            ReDim BernardNavne(0 To 0) As String
            blDimensioned = True 'flag
            End If
            
            ' Adicionamos a letra ao array
            BernardNavne(UBound(BernardNavne)) = Me.ListBox1.List(lItem)
        End If
Next lItem

'Loop through array to see which items were selected from the Listbox:

For lngPosition = LBound(BernardNavne) To UBound(BernardNavne)
MsgBox BernardNavne(lngPosition)
Next lngPosition
End Sub






André Luiz Bernardes








Inline image 1


DONUT PROJECT - VBA - Excel - Importando arquivos CSV




Importar dados de arquivos CSVs é algo tão comum, que o MS Excel já tem um mecanismo próprio para fazer isso. Mas esta continua sendo uma das dúvidas mais comuns. Como fazer essa importação, através do VBA?

Uma alternativa é a de ler o arquivo CSV como se fosse um arquivo texto, e em seguida carregar cada linha em uma matriz, e através de loops inserí-los no MS Excel.

'This sub only provides the sub ImportCSVfile with parameters

Sub InitiateImportCSVFile()
        Dim filePath As String
        Dim ImportToRow As Integer
        Dim StartColumn As Integer      

        Let filePath = "E:\Bernardes\Arquivo.csv"
        Let ImportToRow = 1 'the row where it will start printing
        Let StartColumn = 1 'the start column

        ImportCSVFile filePath, ImportToRow, StartColumn
End Sub

'  Este é o código que faz todo o trabalho:

Sub ImportCSVFile 
(ByVal filePath As String, ByVal ImportToRow As Integer, ByVal StartColumn As Integer) 

    Dim line As String
    Dim arrayOfElements
    Dim element As Variant

    Open filePath For Input As #1 ' Open file for input

        Do While Not EOF(1) ' Loop until end of file

            ImportToRow = ImportToRow + 1

            Line Input #1, line

            Let arrayOfElements = Split(line, ";") 'Split the line into the array.          

            ' Loop thorugh every element in the array and print to Excelfile

            For Each element In arrayOfElements

                Let Cells(ImportToRow, StartColumn).Value = element

                Let StartColumn = StartColumn + 1

            Next

        Loop

    Close #1 ' Close file.
End Sub





André Luiz Bernardes








Inline image 1

DONUT PROJECT - VBA - Excel - Deletando Conexões de Dados



Sim, nos nossos inúmeros projetos com o MS Excel, invariavelmente faremos conexões às mais diversas bases de dados. E talvez desejemos nos desfazermos delas com o tempo, talvez até mesmo logo após atualizarmos a nossa base de dados na planilha.

Este exemplo mostra como excluir a conexão de dados e desativar a definição de consulta após a importação dos dados ser feita:

' Deleta a conexão

 ActiveWorkbook.Connections(Filnavn).Delete

 Dim qt As QueryTable

' Deleta a query

For Each qt In ActiveSheet.QueryTables

         qt.Delete

 Next qt








André Luiz Bernardes








Inline image 1

DONUT PROJECT - VBA - Excel - Obtendo o Nome da Planilha sem a Extensão - Get name of workbook without extension


Suponha que deseje saber o nome da Planilha (workbook) que está usando no momento, mas que este venha sem a sua respectiva extensão, poderia obtê-lo assim:

Function NameOfWorkbook as String

Let NameOfWorkbook = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))

End Function

A forma de resolver isso foi usando a função InStrRev para encontrar a última ocorrência de "." E a função Left() é usada para designar todos os caracteres a esquerda desta posição para a função NameOfWorkbook.