VBA Access - Distributing Access reports using email

Sub RunEmailDist()
       Dim MyDB As Database, MyRecs As Recordset, MyName As String
       Set MyDB = CurrentDb()
       Set MyRecs = MyDB.OpenRecordset("emaildist")

       Let MyName = InputBox("Entre o seu nome","RunEmailDist (CiM)", "Chris Mead (Extn 3841)")

       MyRecs.MoveFirst
       Do While Not MyRecs.EOF

       If MyRecs!distname = Forms("F_ChooseEmail")!DistNameCombo Then
              DoCmd.SendObject acSendReport, "Your budget report", acFormatRTF, MyRecs!SendTo, , , "Budget reports", _
"Please find attached your set of budget reports." & vbCrLF & MyName, 0
       End If

       MyRecs.MoveNext
       Loop

       MyRecs.Close
End Sub

  15.01.2025 

Sub RunEmailDist()

    ' Declaração de variáveis

    Dim MyDB As DAO.Database

    Dim MyRecs As DAO.Recordset

    Dim MyName As String

    Dim distName As String

    Dim sendToEmail As String

    Dim emailSubject As String

    Dim emailBody As String

    

    ' Obtém a referência ao banco de dados atual

    Set MyDB = CurrentDb()

    

    ' Abre o recordset para a tabela ou consulta "emaildist"

    Set MyRecs = MyDB.OpenRecordset("emaildist", dbOpenSnapshot)

    

    ' Solicita o nome do usuário através de uma caixa de entrada

    MyName = InputBox("Entre o seu nome", "RunEmailDist (CiM)", "Chris Mead (Extn 3841)")

    

    ' Verifica se o nome foi fornecido, se não, define um valor padrão

    If Len(MyName) = 0 Then

        MyName = "Usuário sem nome fornecido"

    End If

    ' Obtém o valor selecionado no combo box "DistNameCombo" do formulário "F_ChooseEmail"

    distName = Forms("F_ChooseEmail")!DistNameCombo

    

    ' Inicia a iteração através dos registros do recordset

    If Not MyRecs.EOF Then MyRecs.MoveFirst

    Do While Not MyRecs.EOF

        ' Verifica se o campo distname no recordset corresponde ao valor selecionado no combo box

        If MyRecs!distname = distName Then

            ' Prepara os detalhes do e-mail

            sendToEmail = MyRecs!SendTo

            emailSubject = "Budget reports"

            emailBody = "Please find attached your set of budget reports." & vbCrLf & vbCrLf & "Best regards," & vbCrLf & MyName

            

            ' Envia o e-mail usando o comando DoCmd.SendObject

            DoCmd.SendObject _

                ObjectType:=acSendReport, _

                ObjectName:="Your budget report", _

                OutputFormat:=acFormatRTF, _

                To:=sendToEmail, _

                Subject:=emailSubject, _

                MessageText:=emailBody, _

                EditMessage:=False

            ' Exibe uma mensagem de confirmação para cada e-mail enviado

            Debug.Print "E-mail enviado para: " & sendToEmail

        End If

        

        ' Avança para o próximo registro

        MyRecs.MoveNext

    Loop

    ' Fecha o recordset após a iteração

    MyRecs.Close

    

    ' Limpeza de objetos

    Set MyRecs = Nothing

    Set MyDB = Nothing

    ' Mensagem final para indicar que o processo foi concluído

    MsgBox "E-mails enviados para todos os destinatários correspondentes.", vbInformation, "Envio Concluído"

End Sub

 Clique aqui e nos contate via What's App para avaliarmos seus projetos 

Envie seus comentários e sugestões e compartilhe este artigo!

brazilsalesforceeffectiveness@gmail.com

 Série de Livros nut Project 

  

 PUDIM PROJECT