✔ Programação GLOBAL®: VBA Access - Documentando todos os objetos

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

VBA Access - Documentando Objetos da Aplicação MS Access - Code Documenter

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