Ir para conteúdo
Fórum Script Brasil
  • 0

Help Macro Ferias Vencidas e Macro Enviar Email

WilliamGreco

Perguntado por WilliamGreco,

 Share

Pergunta

WilliamGreco

WilliamGreco

Postado
Postado

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


 

Planilha.jpg

Link para o comentário
Compartilhar em outros sites

2 respostass a esta questão

Posts Recomendados

  • 0
hvonk

hvonk

Postado
Postado (editado)

Infelizmente você vai mofar aqui, VB é a comunidade mais mesquinha e inútil, ninguém ajuda ninguém. Ainda corre o risco de alguém te cobrar pela ajuda. Infelizmente não posso te ajudar porque VB não é minha area. Mw lembra muito o Foxpro mais o Foxpro da de 10 a zero. 

Editado por hvonk
Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,2k
    • Posts
      652k
×
×
  • Criar Novo...