- Katılım
- 10 Haziran 2011
- Mesajlar
- 3
- Excel Vers. ve Dili
- 2003
Merhabalar,
İş takip listesinde listenin ilgili kişiye gitmesini CommandButton1_Click() oluşturdum fakat bunu belli bir zaman diliminde otomatik mail atmasını makro oluşturmaya ile çalıştığımda ilgili saatte Dökümanlar klasörünü açıp bırakmaktadır. Nerede hata yaptığımı bulamadım. Yapmak istediğim excel dosyası açık olmasa bile istenilen saatte listeyi göndermesidir. Yardımcı olabilirseniz sevinirim.
Şimdiden teşekkürler.
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As LongPtr
Sub Aut
pen()
Application.OnTime TimeValue("17:19:00"), "Mail_Gonderimi"
End Sub
Sub Mail_Gonderimi()
Dim Outapp As Object
Dim Outmail As Object
Set Outapp = CreateObject("Outlook.Application")
Set Outmail = Outapp.CreateItem(0)
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
saydir = WorksheetFunction.CountIf(Range("A:A"), "<>") + 1
DinamikAlan = "A2:" & "M10" & saydir
Set Alan = Worksheets("Tasarım").Range(DinamikAlan)
Set Sayfa = ActiveSheet
With Outmail
.To = "a@a.com"
.CC = ""
.BCC = ""
.Subject = "Deneme"
.Body = "Merhaba ," & Chr(13) & _
"proje çalışması." & Chr(13) & _
"Bilginize Sunarım." & Chr(13) & _
"Saygılarımla."
'.Send
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
End With
Set Outmall = Nothing
Set Outapp = Nothing
End Sub
İş takip listesinde listenin ilgili kişiye gitmesini CommandButton1_Click() oluşturdum fakat bunu belli bir zaman diliminde otomatik mail atmasını makro oluşturmaya ile çalıştığımda ilgili saatte Dökümanlar klasörünü açıp bırakmaktadır. Nerede hata yaptığımı bulamadım. Yapmak istediğim excel dosyası açık olmasa bile istenilen saatte listeyi göndermesidir. Yardımcı olabilirseniz sevinirim.
Şimdiden teşekkürler.
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As LongPtr
Sub Aut
pen()Application.OnTime TimeValue("17:19:00"), "Mail_Gonderimi"
End Sub
Sub Mail_Gonderimi()
Dim Outapp As Object
Dim Outmail As Object
Set Outapp = CreateObject("Outlook.Application")
Set Outmail = Outapp.CreateItem(0)
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
saydir = WorksheetFunction.CountIf(Range("A:A"), "<>") + 1
DinamikAlan = "A2:" & "M10" & saydir
Set Alan = Worksheets("Tasarım").Range(DinamikAlan)
Set Sayfa = ActiveSheet
With Outmail
.To = "a@a.com"
.CC = ""
.BCC = ""
.Subject = "Deneme"
.Body = "Merhaba ," & Chr(13) & _
"proje çalışması." & Chr(13) & _
"Bilginize Sunarım." & Chr(13) & _
"Saygılarımla."
'.Send
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
End With
Set Outmall = Nothing
Set Outapp = Nothing
End Sub
