Início
juliobertoso 23/5/2018, 21:12boa tarde!
preciso de uma ajuda para finalizar um projeto, tenho uma tabela que envia e-mail automaticamente.
Ao correr a tabela e verificar o campo "Status" se estiver escrito "Veiculo Liberado" o sistema envia um email com todos os dados da tabela e muda o "Status" de "Veiculo Liberado" para "Agendado"
quando tem só um registro como "Veiculo Liberado" o sistema funciona tranquilo, o problema que tem o Loop e pra verificar a tabela inteira, entao quando passa para segunda linha não altera o Status
segue o código do envio de email
coloquei a função abaixo depois que passa pelo status "Veiculo Liberado" mas acho que não seria assim, pq só esta mudando o 1° registro encontrado e eu quero que mude todos que são necessários
Form_frmAgendamentoSUB.Status = "AGENDADO"
preciso de uma ajuda para finalizar um projeto, tenho uma tabela que envia e-mail automaticamente.
Ao correr a tabela e verificar o campo "Status" se estiver escrito "Veiculo Liberado" o sistema envia um email com todos os dados da tabela e muda o "Status" de "Veiculo Liberado" para "Agendado"
quando tem só um registro como "Veiculo Liberado" o sistema funciona tranquilo, o problema que tem o Loop e pra verificar a tabela inteira, entao quando passa para segunda linha não altera o Status
segue o código do envio de email
coloquei a função abaixo depois que passa pelo status "Veiculo Liberado" mas acho que não seria assim, pq só esta mudando o 1° registro encontrado e eu quero que mude todos que são necessários
Form_frmAgendamentoSUB.Status = "AGENDADO"
- Código:
Public Sub EnviarEmailAgendamento()
' ****IMPORTANTE, NAO ESQUECER DE FAZER A REFERENCIA PARA OUTLOOK ********
'Dim OutApp As Object
'Dim strbody As String
Dim strLocal As String
Dim SigString As String
Dim Signature As String
Dim Assinatura As String
Dim LogoAzul As String
Dim Horario As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
'Referêcia Microsoft Outlook
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim anexo As String
Set db = Application.CurrentDb
Set rs = db.OpenRecordset("tblAgendamentoAZUL") ' Corre a Tabela
'Inicializando o Ms-Outlook
Set OutApp = New Outlook.Application
'Informe o Local onde se encontra sua assinatura, podendo ser no Computador ou URL de Algum Site
Assinatura = "C:\Users\julio.bertoso\Documents\Agendamento\assinatura.png"
LogoAzul = "C:\Users\julio.bertoso\Documents\Agendamento\logo.png"
'EOF = End Of File
Do Until rs.EOF 'faça até o fim do arquivo
'faz a comparação
'If rs.Fields("VencimentoCNH_Funcionario").Value <= rs.Fields("Data_Funcionario4").Value Then '= "Sim"
If rs.Fields("Status").Value = "Veiculo Liberado" Then
Form_frmAgendamentoSUB.Status = "AGENDADO"
'MsgBox "Segue agendamento para: " & " " & rs!Transportadora & " " & rs!Motorista
If Format(Time$, "hh:mm") >= "18:00:00" Then
Horario = "Boa Noite!"
strLocal = "Campinas, " & Format(Date, "dd") & " de " & Format(Date, "mmmm") & " de " & Format(Date, "yyyy") & "."
ElseIf Format(Time$, "hh:mm") >= "12:00:00" Then
Horario = "Boa Tarde!"
strLocal = "Campinas, " & Format(Date, "dd") & " de " & Format(Date, "mmmm") & " de " & Format(Date, "yyyy") & "."
ElseIf Format(Time$, "hh:mm") >= "00:00:00" Then
Horario = "Bom dia!"
strLocal = "Campinas, " & Format(Date, "dd") & " de " & Format(Date, "mmmm") & " de " & Format(Date, "yyyy") & "."
End If
'Novo Email
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = "meuemail@email.com" 'rs.Fields("Email_Transportadora").Value
.CC = ""
.BCC = "" 'Copia oculta
.Subject = "Agendamento de" & " " & rs!Tipo & " " & "para transportadora" & " " & rs!Transportadora & " " & "dia " & rs!Data & " " & "- " & rs!Horario 'txtAssunto ' ver um jeito de nao deixar em branco
.BodyFormat = olFormatHTML
'<img src="/images/hackanm.gif" width="20" height="20">
.HTMLBody = "<HTML><BODY><FONT FACE=Calibri (Corpo) COLOR=1F497D<B>" & _
"<img src=" & LogoAzul & ">" & "<BR><BR>" & _
strLocal & _
"</B><BR><BR>" & Horario & "<BR><BR></BR>" & _
"Segue agendamento de " & rs!Tipo & " " & "para transportadora abaixo:" & "<BR><BR></BR>" & _
" " & "<B>" & "Data: " & "</b>" & rs!Data & " " & "<B>" & "Horário: " & "</B>" & rs!Horario & _
"<BR><BR>" & "<B>" & "Veículo: " & "</B>" & " " & rs!TipodeVeiculo & "<B>" & " " & "Placa: " & "</B>" & " " & rs!Placa & "<BR>" & _
"" & "<B>" & "Rotina: " & "</B>" & " " & rs!Rotina & "<B>" & " " & "Tipo: " & "</B>" & " " & rs!Tipo & "<BR><BR>" & _
"" & "<B>" & "Transportadora: " & "</B>" & " " & rs!Transportadora & "<BR>" & _
" " & "<B>" & "Motorista: " & "</B>" & rs!Motorista & " " & "<B>" & "RG: " & "</B>" & rs!RG_Motorista & "<BR>" & _
" " & "<B>" & "Ajudante: " & "</B>" & rs!Ajudante & " " & "<B>" & "RG: " & "</B>" & rs!RG_Ajudante & "<BR><BR>" & _
"" & "<B>" & "Empresa: " & "</B>" & " " & rs!Empresa & "<BR>" & _
" " & "<B>" & "Responsável: " & "</B>" & rs!Responsavel & " " & "<B>" & "Telefone: " & "</B>" & rs!Telefone & "<BR>" & _
"<B>" & "<BR>" & _
"<BR> Atenciosamente, <BR><BR><BR> <img src=" & Assinatura & ">" & "</FONT></BODY></HTML>"
.Display
'.Body = "CNH de " & " " & rs!Nome_Funcionario & " do setor " & rs!Departamento_Funcionario & " esta vencida, favor solicitar a renovação, venceu dia " & rs!VencimentoCNH_Funcionario 'txtCorpo
'.Attachments.Add anexo = Application.CurrentProject.Path & "\Agenda\" & rs.Fields("Transportadora").Value & ".pdf"
.Display
'.Send
End With
'Libera memória
Set OutMail = Nothing
End If
rs.MoveNext
Loop
'fechar conexão
rs.Clone
db.Close
'libera memória
Set rs = Nothing
Set db = Nothing
Set OutApp = Nothing
'MsgBox "foi enviado um email automático informando!", vbInformation
End Sub