MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Mostrar Escopo da Execução

    Compartilhe

    Ednardo
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 22
    Registrado : 20/11/2015

    [Resolvido]Mostrar Escopo da Execução

    Mensagem  Ednardo em 5/11/2018, 19:09

    Boa Tarde, estou criando uma rotina para tratamento de erros, (segue em anexo imagem), preciso incluir mais uma informação abaixo que é o nome do Escopo ou Evento, de forma automatizada, gostaria de saber dos mais experientes se tem um comando para mostrar o escopo onde o código esta rodando Ex: Private Sub Check_Click(), pois já tenho a informação do Código Erro, Mensagem Erro, Linha Erro, Tipo de Objeto Erro, Nome Objeto Erro, Escopo Erro (Falta), para que eu possa ir direto ao local para correção do mesmo.

    Vou colocar o código para melhor entendimento...
    Código:
    Private Sub Check_Click()
    On Error GoTo TratarErro
    1    If Me.Caminho <> "" Then
    2        Dim DBS As DAO.Database
    3        Dim WS As DAO.Workspace
    4        Set DBS = DBEngine.Workspaces(0).OpenDatabase(Me.Caminho, False, False, "MS Access;PWD=" & Me.Senha)
    5        If DBS.Properties("AllowBypassKey").Value = True Then
    6            Me.BTDesabilita.Enabled = True
    7            Me.Check.Enabled = False
    8        Else
    9            Me.BTHabilita.Enabled = True
    10          Me.Check.Enabled = False
    11      End If
    21  End If
    Sair:
    Exit Sub
    TratarErro:
    If Err.Number = 3270 Then
        Me.BTDesabilita.Enabled = True
        Me.Check = False
        Err.Clear
    Else
        DoCmd.OpenForm "MSN", , , , , acDialog, "1;" & Err.Number & ";" & Err.Description & ";" & CStr(Erl) & ";" & fncObjectType(Access.CurrentObjectType) & ";" & Access.CurrentObjectName
        Resume Sair:
    End If
    End Sub

    O formulário após aberto organiza as informações do OpenArgs igualmente a imagem anexo!
    Anexos
    Capturar.PNG
    Você não tem permissão para fazer download dos arquivos anexados.
    (33 Kb) Baixado 2 vez(es)
    avatar
    thiagomcosta
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 306
    Registrado : 23/01/2017

    Re: [Resolvido]Mostrar Escopo da Execução

    Mensagem  thiagomcosta em 5/11/2018, 23:27

    O Harysohn postou alguma coisa a respeito. Vi em vários tópicos. Um deles é:
    [Você precisa estar registrado e conectado para ver este link.]

    Outra solução que pode resolver seu problema:
    [Você precisa estar registrado e conectado para ver este link.]

    Ednardo
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 22
    Registrado : 20/11/2015

    Re: [Resolvido]Mostrar Escopo da Execução

    Mensagem  Ednardo em 6/11/2018, 16:40

    Boa Tarde, consegui resolver meu problema com a luz dos tópicos que me passaram, vou repassar para os demais para aproveitamento em sua aplicações e aprimoramento das mesmas.
    Adaptei o seguinte função em um módulo a minha aplicação:

    Código:
    Public Function CheckEscopo(ID As Double) As String
    Dim VBEditor As VBIDE.VBE '>>>Microsift Visual Basic for Applications Extensibility 5.3<<<
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    Dim CodeMod As VBIDE.CodeModule
    Dim modname
    Dim a, afin, b, bfin, c, cfin, ch, chfin, myn
    Dim mtxtline, mtxtsub
    Set VBEditor = Application.VBE
    Set VBProj = VBEditor.ActiveVBProject
    afin = VBProj.VBComponents.Count
    For a = 1 To afin
        Set VBComp = VBProj.VBComponents(a)
        Set CodeMod = VBComp.CodeModule
        bfin = CodeMod.CountOfLines
        For b = 1 To bfin
            If InStr(1, CodeMod.Lines(b, 1), ID, vbTextCompare) > 0 Then
                CheckEscopo = CodeMod.Lines(b - 1, 1)
                Set VBEditor = Nothing
                Set VBProj = Nothing
                Set VBComp = Nothing
                Set CodeMod = Nothing
                Exit Function
            End If
        Next
    Next
    Set VBEditor = Nothing
    Set VBProj = Nothing
    Set VBComp = Nothing
    Set CodeMod = Nothing
    End Function

    Em seguida coloco um id de referência no meu escopo...

    Código:
    Private Sub Check_Click()
    On Error GoTo TratarErro 'ID: 061120181346
    1    If Me.Caminho <> "" Then
    2        Dim DBS As DAO.Database
    3        Dim WS As DAO.Workspace
    4        Set DBS = DBEngine.Workspaces(0).OpenDatabase(Me.Caminho, False, False, "MS Access;PWD=" & Me.Senha)
    5        If DBS.Properties("AllowBypassKey").Value = True Then
    6            Me.BTDesabilita.Enabled = True
    7            Me.Check.Enabled = False
    8        Else
    9            Me.BTHabilita.Enabled = True
    10           Me.Check.Enabled = False
    11       End If
    21   End If
    Sair:
    Exit Sub
    TratarErro:
    If Err.Number = 3270 Then
        Me.BTDesabilita.Enabled = True
        Me.Check = False
        Err.Clear
    Else
        MsgBox Err.Source
        DoCmd.OpenForm "MSN", , , , , acDialog, "1;" & Err.Number & ";" & Err.Description & ";" & CStr(Erl) & ";" & fncObjectType(Access.CurrentObjectType) & ";" & Access.CurrentObjectName & ";" & CheckEscopo("061120181346")
        Resume Sair:
    End If
    End Sub

    O que o módulo faz é percorrer todo o código do projeto para achar o ID de referência, ao encontra-lo passa exatamente a linha anterior, espero que isso ajude a outros, Bons Estudos!!!

    O resultado está a baixo!
    Anexos
    Capturar.PNG
    Você não tem permissão para fazer download dos arquivos anexados.
    (42 Kb) Baixado 2 vez(es)

      Data/hora atual: 14/11/2018, 11:52