Jump to content
Fórum Script Brasil
  • 0

Executar Macro na hora determinada


acsatiro
 Share

Question

Boa Tarde. Gostaria da ajuda de vocês para criar um código pra executar uma macro em uma determinada hora. Estou tentando mas não está funcionando. Acho que estou comendo mosca em algum momento. Segue o código abaixo. valeu.

 

Sub enviar_email()
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
      
    Dim picname As String
    Dim grafico As Chart
    Dim MyOlapp As Object, MeuItem As Object
    
    Set MyOlapp = CreateObject("Outlook.Application")
    Set MeuItem = MyOlapp.CreateItem(olMailItem)

    ActiveWorkbook.RefreshAll
    
    ActiveWorkbook.Sheets("plan1").ChartObjects(1).Activate
    Set grafico = ActiveWorkbook.Sheets("plan1").ChartObjects(1).Chart
    grafico.Export Filename:="C:\temp\Grafico1.jpg", filtername:="JPG"
    
    Worksheets("plan2").Activate
    
    ActiveWorkbook.Sheets("plan2").ChartObjects(1).Activate
    Set grafico = ActiveWorkbook.Sheets("plan2").ChartObjects(1).Chart
    grafico.Export Filename:="C:\temp\Grafico2.jpg", filtername:="JPG"
          
    Worksheets("plan3").Activate
    
    ActiveWorkbook.Sheets("plan3").ChartObjects(1).Activate
    Set grafico = ActiveWorkbook.Sheets("plan3").ChartObjects(1).Chart
    grafico.Export Filename:="C:\temp\Grafico3.jpg", filtername:="JPG"
    
    Worksheets("plan4").Activate
   
    ActiveWorkbook.Sheets("plan4").ChartObjects(1).Activate
    Set grafico = ActiveWorkbook.Sheets("plan4").ChartObjects(1).Chart
    grafico.Export Filename:="C:\temp\Grafico4.jpg", filtername:="JPG"
      
    Set MyOlapp = CreateObject("Outlook.Application")
    Set myItem = MyOlapp.CreateItem(olMailItem)
    Set myAttachments = myItem.Attachments
    
    Worksheets("dados").Activate
    
    
    'Faturamento Cachaça
    Range("c7").Select
    texto1 = ActiveCell
   
    'Faturamento por dia
    Range("c9").Select
    Texto2 = ActiveCell
    
    'Faturamento por Mês
    Range("c10").Select
    Texto3 = ActiveCell
    
    'Faturamento Orçado no Mês
    Range("c11").Select
    Texto4 = ActiveCell
    
    'Vendas em Litros
    Range("c12").Select
    Texto5 = ActiveCell
       
       
  
With MeuItem
    .BCC = ("index1")
    .Subject = "Faturamento Cachaça"
    
    .HTMLBody = " " & ActiveWorkbook.Sheets("DADOS").Range("C14").Value & "" & _
    "<BR><BR>" & _
    "<b>" & texto1 & "</b>" & "<br>" & "<br>" & _
    Texto2 & "<br>" & _
    Texto3 & "<br>" & _
    Texto4 & "<br>" & _
    Texto5 & "<br>" & _
    "<BR><BR>" & _
    "<img src='C:\temp\Grafico1.jpg'>" & _
    "<BR><BR>" & _
    "<img src='C:\temp\Grafico2.jpg'>" & _
    "<BR><BR>" & _
    "<img src='C:\temp\Grafico3.jpg'>" & _
    "<BR><BR>" & _
    "<img src='C:\temp\Grafico4.jpg'>" & _
    "<BR><BR>" & _
    "<i>" & "E-mail gerado automaticamente - Favor não responder." & "</i>"
      
    .Display
          
    .send
           
    
End With

    
    ActiveWorkbook.Save
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    
    OnTime1


End Sub
Public Sub OnTime1()
Call Application.OnTime(TimeValue("12:00:00"), "enviar_email")

End Sub

Link to comment
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

  • Forum Statistics

    • Total Topics
      149.6k
    • Total Posts
      646.2k
×
×
  • Create New...