VBA Access - Documentando todos os objetos

VBA Access - Documentando todos os objetos - Loop Through All Objects

Obs: Arquivo da Net....


Para os que não gostam de documentar as suas aplicações, saibam, me agradecerão depois. Documentar é essencial para mantermos certa ordem sob os nossos códigos. Acreditem, ninguém tem uma memória tão prodigiosa ao ponto de não esquecer tudo o que desenvolveu em uma semana. Resguardar-se não lhe fará mal. Tendo isso em mente, sirvo-lhes um código que tem por objetivo expor todos os objetos da sua aplicação MS Access.

São códigos que fazem 'loopings' na maioria das coleções que desejamos documentar dentro de um projeto. E é lógico, isso pode ser ampliado e melhorado.

GUARDEM ESSES CÓDIGOS NUM LUGAR QUE POSSAM ACESSAR FACILMENTE QUANDO PRECISAREM. POIS ACREDITEM, VOCÊS PRECISARÃO.

Boa diversão!

   'Loop em todos os formulários:

   Public Sub FormsLoopSkeleton()
       'Código para percorrer todo os Forms da coleção (formulários fechados).
       Dim myForm As AccessObject

       For Each myForm In CurrentProject.AllForms
           
           'Código visualizar os nomes
           Debug.Print myForm.Name
       
       Next
   End Sub

   'Loop em todos os relatório:

   Public Sub LoopThroughAllReports()
       Dim myReport As AccessObject
       For Each myReport In CurrentProject.AllReports
           
           ''Código visualizar os nomes
           Debug.Print myReport.Name
           
       Next
   End Sub

   'Loop em todos os formulários abertos:


   Public Sub LoopThroughOpenForms()
       Dim myForm As Form
       For Each myForm In Forms
           
           'Código visualizar os nomes
           Debug.Print myForm.Name
           
       Next
   End Sub

   'Loop em todos os relatórios abertos:

   Public Sub LoopThroughOpenReports()
       Dim myReport As Report
       For Each myReport In Reports
           
           'Código visualizar os nomes
           Debug.Print myReport.Name
           
       Next
   End Sub

   'Loop em todas as queries:

   Public Sub QueriesLoopSkeleton()
       Dim myObject As AccessObject
       For Each myObject In CurrentData.AllQueries
           
           'Código visualizar os nomes
           Debug.Print myObject.Name
       
       Next
   End Sub

   'Loop em todas as TABELAS:

   Public Sub TablesLoopSkeleton()
       Dim myObject As AccessObject
       For Each myObject In CurrentData.AllTables
           
           'Código visualizar os nomes
           Debug.Print myObject.Name
       
       Next
   End Sub


   'PLUS: Extraindo todos os Labels.

   Sub SkipLabels(ReportName As String, LabelsToSkip As Byte, Optional PassedFilter As String)

       'Declara algumas variáveis.
       Dim MySQL, RecSource, FldNames As String
       Dim MyCounter As Byte
       Dim myReport As Report

       'Desligas as mensagens de aviso.
       DoCmd.SetWarnings False
       
       ' Copia todos os LABELS originais do relatório
       ' para o objeto LabelsTempReport
       DoCmd.CopyObject , "LabelsTempReport", acReport, ReportName

       ' Abre o objeto LabelsTempReport na visão de Design.
       DoCmd.OpenReport "LabelsTempReport", acViewDesign

       ' Obtém os nomes das queries e consultas sob os relatórios,
       ' e os guarda aqui na variável RecSource .
       Let RecSource = Reports!LabelsTempReport.RecordSource

       ' Fecha o objeto LabelsTempReport
       DoCmd.Close acReport, "LabelsTempReport", acSaveNo
     
       'Declara um Recordset ADODB chamado de MyRecordSet
       Dim cnn1 As ADODB.Connection
       Dim MyRecordSet As New ADODB.Recordset

       Set cnn1 = CurrentProject.Connection
       Let MyRecordSet.ActiveConnection = cnn1
     
       ' Lê os dados do objeto RecSource para o objeto MyRecordSet
       Let MySQL = "SELECT * FROM [" + RecSource + "]"
       MyRecordSet.Open MySQL, , adOpenDynamic, adLockOptimistic

       ' Extrai os nomes dos campos e os seus
       ' respectivos tipos da coleção Fields collection.
       Dim MyField As ADODB.Field
       
       For Each MyField In MyRecordSet.Fields
           ' Converte o campo AutoNumber (Tipo=3) para Long
           ' para evitar problemas de inserção posterior.
           If MyField.Type = 3 Then
               Let FldNames = FldNames + "CLng([" + RecSource + _
                   "].[" + MyField.Name + "]) As " + MyField.Name + ","
           Else
               Let FldNames = FldNames + _
                   "[" + RecSource + "].[" + MyField.Name + "],"
           End If
       Next
       'Remove vírgula a direita.
       Let FldNames = Left(FldNames, Len(FldNames) - 1)
     
       'Cria uma tabela vazia com a mesma estrutura RecSource,
       'sem quaisquer campos AutoNumeração.
       Let MySQL = "SELECT " + FldNames + _
           " INTO LabelsTempTable FROM [" + _
           RecSource + "] WHERE False"

       MyRecordSet.Close

       DoCmd.RunSQL MySQL
     
       ' A seguir adiciona registros em branco para
       ' esvaziar no objeto LabelsTempTable.
       Let MySQL = "SELECT * FROM LabelsTempTable"
       MyRecordSet.Open MySQL, , adOpenStatic, adLockOptimistic

       For MyCounter = 1 To LabelsToSkip
           MyRecordSet.AddNew
           MyRecordSet.Update
       Next

       'Agora o objeto LabelsTempTable tem registros vazios suficientes nele.
       MyRecordSet.Close

       ' Construa uma cadeia de SQL para anexar todos os registros da fonte
       ' original (RecSource) no objeto LabelsTempTable.
       Let MySQL = "INSERT INTO LabelsTempTable"
       Let MySQL = MySQL + " SELECT [" + RecSource + _
           "].* FROM [" + RecSource + "]"

       ' Adere à condição PassedFilter, se existir.
       If Len(PassedFilter) > 1 Then
           MySQL = MySQL & " WHERE " & PassedFilter
       End If

       ' Acrescenta os registros
       DoCmd.RunSQL MySQL

       ' O objeto LabelsTempTable está pronto agora
       ' Em seguida nós fazemos LabelsTempTable o registro fonte
       ' para LabelsTempReport.
       DoCmd.OpenReport "LabelsTempReport", acViewDesign, , , acWindowNormal
       Set myReport = Reports![LabelsTempReport]
       Let MySQL = "SELECT * FROM LabelsTempTable"
       Let myReport.RecordSource = MySQL

       DoCmd.Close acReport, "LabelsTempReport", acSaveYes

       ' Agora podemos finalmente imprimir os labels.
       'DoCmd.OpenReport "LabelsTempReport", acViewPreview, , , acWindowNormal

       'Nota: As written, procedure just shows labels in Print Preview.
       'To get it to actually print, change acPreview to acViewNormal
       'in the statement above.
       ' Como escrito, o procedimento só mostra labels na prévia de impressão '
       ' para obtê-los realmente para imprimir,
       ' altere acPreview para acViewNormal na declaração acima.
   End Sub

Muito bom, obrigado pelo compartilhamento!