WilliamGreco

Alguém pode me ajudar?

Boa Noite, Caros amigos, sou novo neste fórum e preciso muito da ajuda de vocês, pois estou engatinhando ainda na programação com VBA... Tenho que realizar uma macro que faça um calculo que se o limite de ferias do funcionário for menor que 30 dias enviar um e-mail para o funcionário com copia para o gestor dele... depois de 1 hora enviar outro e-mail agora para o gestor informando o não agendamento das ferias e com copia para o funcionário depois de 1 hora enviar outro e-mail agora para o gestor do gestor com copia dos antecessores... Tenho que fazer isso usando o sistema de e-mail lotus notes... peguei um código como modelo... mas não estou conseguindo fazer a estrutura do código... Código... VBA Lotus Notes Sub envio() Dim Maildb As Object Dim MailDoc As Object Dim Body As Object Dim Session As Object Dim notesField As Object Dim notesEmbeddedObject As Object Dim AttachME As Object 'The attachment richtextfile object Dim EmbedObj As Object 'The embedded object (Attachment) Dim UserName As String 'The current users notes name For vx = 2 To 9999 'Abre a seção Set Session = CreateObject("Lotus.NotesSession") 'Esta linha abre uma tela para digitar a password Call Session.Initialize("123456789") 'Abre a DataBase do email Set Maildb = Session.GETDATABASE("", "names.nsf") If Not Maildb.IsOpen = True Then Call Maildb.Open End If UserName = Session.UserName 'Cria o documento Set MailDoc = Maildb.CREATEDOCUMENT Call MailDoc.ReplaceItemValue("Form", "Memo") vchapa = Cells(vx, 1) vnome = Cells(vx, 2) vdesti = Cells(vx, 3) vnomedep = Cells(vx, 4) vParentesco = Cells(vx, 5) vDtnasc = Cells(vx, 6) vnascimento = Cells(vx, 7) If vdesti = "" Then Exit For End If 'Seleciona o destinatário Call MailDoc.ReplaceItemValue("SendTo", vdesti) Call MailDoc.ReplaceItemValue("CopyTo", "ERICASIL") ' com cópia para 'Call MailDoc.AppendItemValue("blindcopyTo", "phallida") Call MailDoc.AppendItemValue("blindcopyTo", "marcafer") ' Copia oculta 'Digita o assunto Call MailDoc.ReplaceItemValue("Subject", "CPF DOS DEPENDENTES") 'Cria e escreve o que vai no corpo da menssagem Set Body = MailDoc.CREATERICHTEXTITEM("Body") Call Body.APPENDTEXT("Sr.(a) " & vnome & " - Chapa: " & vchapa) Call Body.ADDNEWLINE(3) Call Body.APPENDTEXT("suas ferias estão para vencer em um mês favor agendar.") Call Body.ADDNEWLINE(2) Call Body.APPENDTEXT("obrigado.") Call Body.ADDNEWLINE(3) Call Body.APPENDTEXT(" Nome Dependente" & Space(70) & "Parentesco" & Space(20) & "Data Nascimento" & Space(11) & " CPF" & Space(11)) Call Body.ADDNEWLINE(2) va = 0 While va = 0 If Cells(vx + 1, 1) <> vchapa Then va = 1 End If vnomedep = Trim(Cells(vx, 4)) espaco = (48 - Len(Trim(vnomedep))) * 2 vParentesco = Cells(vx, 5) vDtnasc = Cells(vx, 6) Call Body.APPENDTEXT(vnomedep & Space(espaco) & Space(10) & vParentesco & Space(15) & vDtnasc & Space(15) & "_____________________") Call Body.ADDNEWLINE(2) If Cells(vx + 1, 1) = vchapa Then vx = vx + 1 End If Wend ' FindNext "NomeCliente = '" & sArg & "'" ' If Attachment <> "" Then ' Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment") ' Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", vArquivo, "Attachment") ' Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", ' End If Call Body.ADDNEWLINE(2) Call Body.APPENDTEXT("Administração de Pessoal") Call Body.ADDNEWLINE(1) Call Body.APPENDTEXT("Obrigado") 'Salva o email enviado MailDoc.SAVEMESSAGEONSEND = True 'Envia o email 'Coloca o email na pasta de email enviados Call MailDoc.ReplaceItemValue("PostedDate", Now()) Call MailDoc.SEND(False) 'Limpa tudo Set Maildb = Nothing Set MailDoc = Nothing Set Body = Nothing Set Session = Nothing Next End Sub Sub Gestor() Dim Maildb As Object Dim MailDoc As Object Dim Body As Object Dim Session As Object Dim notesField As Object Dim notesEmbeddedObject As Object Dim AttachME As Object 'The attachment richtextfile object Dim EmbedObj As Object 'The embedded object (Attachment) Dim UserName As String 'The current users notes name For vx = 2 To 999 'Abre a seção Set Session = CreateObject("Lotus.NotesSession") 'Esta linha abre uma tela para digitar a password Call Session.Initialize("123456789") 'Call Session.Initialize("LOTUSNOTES") 'Abre a DataBase do email Set Maildb = Session.GETDATABASE("", "names.nsf") If Not Maildb.IsOpen = True Then Call Maildb.Open End If UserName = Session.UserName 'Cria o documento Set MailDoc = Maildb.CREATEDOCUMENT Call MailDoc.ReplaceItemValue("Form", "Memo") vchapa = Cells(vx, 1) vnome = Cells(vx, 2) vchapagestor = Cells(vx, 3) vnomegestor = Cells(vx, 4) vdesti = Cells(vx, 5) vnomedep = Cells(vx, 6) vParentesco = Cells(vx, 7) vDtnasc = Cells(vx, 8) vnascimento = Cells(vx, 9) If vdesti = "" Then Exit For End If 'Seleciona o destinatário Call MailDoc.ReplaceItemValue("SendTo", "william@hotmail.com") Call MailDoc.ReplaceItemValue("CopyTo", "Angela@hotmail.com") ' com cópia para 'Call MailDoc.AppendItemValue("blindcopyTo", "") ' Copia oculta 'Call MailDoc.AppendItemValue("blindcopyTo", "") ' Copia oculta 'Digita o assunto Call MailDoc.ReplaceItemValue("Subject", "CPF DOS DEPENDENTES") 'Cria e escreve o que vai no corpo da menssagem Set Body = MailDoc.CREATERICHTEXTITEM("Body") Call Body.APPENDTEXT("Sr.(a) " & vnomegestor) Call Body.ADDNEWLINE(2) Call Body.APPENDTEXT("Favor solicitar para seu empregado a informação abaixo, que será utilizada para emissão do Informe.") Call Body.ADDNEWLINE(3) Call Body.APPENDTEXT("Sr.(a) " & vnome & " - Chapa: " & vchapa) Call Body.ADDNEWLINE(3) Call Body.APPENDTEXT("suas ferias estão para vencer em um mês favor agendar.") Call Body.ADDNEWLINE(2) Call Body.APPENDTEXT("obrigado.") Call Body.ADDNEWLINE(3) Call Body.APPENDTEXT(" Nome Dependente" & Space(70) & "Parentesco" & Space(20) & "Data Nascimento" & Space(11) & " CPF" & Space(11)) Call Body.ADDNEWLINE(2) va = 0 While va = 0 If Cells(vx + 1, 1) <> vchapa Then va = 1 End If vnomedep = Trim(Cells(vx, 6)) espaco = (48 - Len(Trim(vnomedep))) * 2 vParentesco = Cells(vx, 7) vDtnasc = Cells(vx, 8) Call Body.APPENDTEXT(vnomedep & Space(espaco) & Space(10) & vParentesco & Space(20) & vDtnasc & Space(10) & "_____________________") Call Body.ADDNEWLINE(2) If Cells(vx + 1, 1) = vchapa Then vx = vx + 1 End If Wend ' FindNext "NomeCliente = '" & sArg & "'" ' If Attachment <> "" Then ' Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment") ' Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", vArquivo, "Attachment") ' Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", ' End If Call Body.ADDNEWLINE(2) Call Body.APPENDTEXT("Administração de Pessoal") Call Body.ADDNEWLINE(1) Call Body.APPENDTEXT("Obrigado") 'Salva o email enviado MailDoc.SAVEMESSAGEONSEND = True 'Envia o email 'Coloca o email na pasta de email enviados Call MailDoc.ReplaceItemValue("PostedDate", Now()) Call MailDoc.SEND(False) 'Limpa tudo Set Maildb = Nothing Set MailDoc = Nothing Set Body = Nothing Set Session = Nothing Next End Sub