MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

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

    Código deixando lento a aplicação no access

    avatar
    FabioR
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 48
    Registrado : 27/10/2021

    Código deixando lento a aplicação no access Empty Código deixando lento a aplicação no access

    Mensagem  FabioR 25/9/2022, 11:22

    Olá pessoal!
    Preciso de uma ajuda para identificar o porque que o código abaixo está deixando minha aplicação lenta.
    Esse código é acionado quando clico no botao, mas depois de executado umas 3 ou 4 vezes ele chega a travar o access sendo liberado somente quando deletado pelo gerenciador de tarefas.

    Se conseguirem identificar o que causa essa lentidão e travamento, agradeço.

    Option Compare Database
    Option Explicit

    Public Function SendMailHE()
    Dim rs As DAO.Recordset
    Dim txtnome As String
    Dim txtHEntrada As String
    Dim txtContEntrada As String
    Dim txtContSaida As String
    Dim txtEmail_Pai As String
    Dim txtEmail_Mae As String
    Dim txtData As String

    Set rs = CurrentDb.OpenRecordset("SELECT * FROM Con_HE_SendEmail_Pais where Con_HE_SendEmail_Pais.[registro]= " & [Forms]![Aluno1]![Registro] & "")

    txtnome = StrConv(rs!Nome, vbProperCase)
    txtHEntrada = Format(rs!HEntrada, "hh:mm")
    txtContEntrada = Format(rs!horacontr_entrada, "hh:mm")
    txtContSaida = Format(rs!horacontr_saida, "hh:mm")
    txtEmail_Pai = Nz(rs!Email_Pai, Nz(rs!email_Mae, "sem email"))
    txtEmail_Mae = Nz(rs!email_Mae, Nz(rs!Email_Pai, "sem email"))
    txtData = rs!Data

    If (txtHEntrada) <> "" Then

    Dim Obj As Object

    Set Obj = CreateObject("CDO.Message")
    With Obj.Configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "email-ssl.com.br"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "email FROM"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "senha"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
    .Update
    End With

    With Obj
    .To = txtEmail_Pai & ";" & txtEmail_Mae
    .BCC = "email oculto"
    .FROM = "Notificação"
    .Subject = "" & txtnome & " - Hora adicional gerada em " & txtData
    .HTMLBody = "Prezados Pais!

    Informamos que foi gerado " & txtHEntrada & " de hora adicional devido a entrada antecipada.

    " & " Período contratado.
    Entrada: " & txtContEntrada & "

    Saída: " & txtContSaida & "

    Em caso de dúvida, pedimos a gentileza de entrar em contato pelo WhatsApp " & "(11) xxxxxxxxx.""
    Esta caixa de email não recebe mensagem.



    A Direção"

    End With

    On Error Resume Next
    Obj.Send

    If Err.Number <> 0 Then
    MsgBox "CDO Error " & vbNewLine & Err.Description, vbCritical, "Avíso"
    Else
    'MsgBox "Mensaje enviado con éxito", vbInformation, "Avíso"
    End If
    rs.Close
    Set rs = Nothing
    Set Obj = Nothing

    End If
    End Function

      Data/hora atual: 8/2/2023, 00:08