Views

Histats

Vitrine

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

Inline image 1


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


Tags: VBA, Access, Loop, object, schema



✔ VBA Brazil®

✔ VBA Brazil®
brazilsalesforceeffectiveness@gmail.com
Related Posts Plugin for WordPress, Blogger...
diHITT - Notícias