otomatik mail gönderme hk;

[mahmyt]

Merhabalar;
Forumda bulduğum koda günde 1 defa olacak şekilde otomatik saat girmek istediğimde kod çalışmamaktadır.
üzerinde çalıştığım excel ve kodlar aşağıdaki gibidir.

örnek olacak olursa günde 1 kez 16.59 da ilgili kişilere otomatik mail atmasını istiyorum.
konuyla ilgili yardımcı olabilirseniz çok sevinirim.

Şimdiden herkese teşekkür ederim.

Sub Auto_Open()
    Application.OnTime TimeValue("12:46:00"), "Mail"
      
End Sub

Sub Mail()
      Dim wrdEdit
      Dim alan As Range
      sonsatir = Cells(Rows.Count, "A").End(3).Row
      tarih = CDate(Cells(6, "J").Value)
      
  
      
      Set alan = Range("A1:F" & sonsatir)
            
      Set OutApp = CreateObject("Outlook.Application")
      Set OutMail = OutApp.CreateItem(0)
      With OutMail
       .To = Cells(1, "J").Value
       .CC = Cells(2, "J").Value
       .BCC = ""
       .Subject = Cells(3, "J").Value
       .Display
      
       'Maili otomatik göndermek için .send deki tırnak işaretini kaldırın.
       .send
       .HTMLBody = Cells(4, "J").Value
       End With
 
      Set wrdEdit = Nothing
      Set OutMail = Nothing
      Set OutApp = Nothing
End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

 

[ermanusta]

Application.OnTime TimeValue("16:59:00"), "Mail"
Yapın

 

[denizfatihi]

Merhaba,

Bende çalıştırmayı bir türlü başaramadım eksik bir şey mi yapıyorum ?
Bir modul içerisine aşağıdaki kodları ekliyorum, bu süre zafında kullanılan excel kitabı gün boyu hep açık ve üzerinde çalışılıyor.
Belirtilen zaman geliyor yanlız kod harekete geçmiyor, F5 veya F8 ile normal bir şekilde çalışıyor.
Şimdiden teşekkür ederim, iyi günler.

Sub Zamanı_Geldi()
Application.OnTime TimeValue("10:14:00"), "Mesaj"
End Sub

Sub Mesaj()
MsgBox "deneme"
End Sub

 

[Korhan Ayhan]

Ofis 365 sürümde şimdi denedim. Bir sorun yaşamadım.

 

[denizfatihi]

Korhan hocam teşekkür ederim, ama sanırım biz biraz teknolojik olarak geride kalmışız hala office 2010 kullanıyoruz bu sebeple ek bir ayar mı yapmak gerekli diye düşünüyorum.

 

[Korhan Ayhan]

... hala office 2010 kullanıyoruz ...

Bu durumda profilinizdeki bilgi güncellemenizde fayda var. Ofice 2007 sürümü yazıyor.

Eski sürüm kullanan başka üyelerimizin deneme fırsatı varsa sorunu tespit edebiliriz.

 

[denizfatihi]

Evet üye olalı epeyce bir zaman olmuş fark etmemişim şimdi Office 2010 olarak güncelledim, sorun içinde biraz daha araştırma yaparım, teşekkür ederim.

 

[Korhan Ayhan]

Kullandığınız ofis dilinide profilinize yazarsanız daha faydalı olacaktır.