Outlook Gönder (Send) Sekmesini kodlamak

baydeniro

Altın Üye
Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Merhaba

Outlook programı açıkken ve ekranda göndermeye hazır bir mail varken excelden "GÖNDER" tuşunu makro kodu ile tıklatmak mümkün mü acaba ?
 

baydeniro

Altın Üye
Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Outlook programı açıkken ve ekranda göndermeye hazır bir mail varken excelden "GÖNDER" tuşunu makro kodu ile tıklatmak mümkün mü acaba ?
 

mancubus

Destek Ekibi
Destek Ekibi
Katılım
6 Ocak 2010
Mesajlar
2,224
Excel Vers. ve Dili
İŞ: 2021 Win Eng
Kod:
Sub xlTR_174358()
'VBE / Tool / References / Microsoft Outlook XX.X Object Library
   
    Dim olMail As MailItem, olInspector As Inspector
   
    Set olInspector = Outlook.ActiveInspector
    Set olMail = olInspector.CurrentItem

    olMail.Send

End Sub
 
Son düzenleme:

baydeniro

Altın Üye
Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Mancubus üstadım ilginize çok teşekkür ediyorum. Nedense References alanında Microsoft Outlook 16.0 Object Library seçimini kaydetmiyor. Dosyayı kapatıp açınca seçim kayboluyor ve eski halinde dönük olarak açılıyor. Ondan önce başka bir tanımlama daha mı yapmak lazım acaba ?
 

mancubus

Destek Ekibi
Destek Ekibi
Katılım
6 Ocak 2010
Mesajlar
2,224
Excel Vers. ve Dili
İŞ: 2021 Win Eng
bir çok sebebi olabilir.

genellikle yetki kaynaklı sorunlar oluyor.
network dosyası ise erişim yetkileri söz konusu olabilir.
kütüphanelerin bulunduğu klasöre sadece admin yetkisi olan kullanıcıların erişim yetkisi olabilir. bu nedenle iptal ediyor olabilir.

ekte çalışan bir dosya ekledim.
deneyin, aynı şey tekrar ediyor mu?
 

Ekli dosyalar

Son düzenleme:
Katılım
20 Eylül 2005
Mesajlar
119
Excel Vers. ve Dili
2016 - Türkçe
Kolay gelsin excel 2010 daki excel den outlook takvime veri gönderme yapıyordum. 2016 yükledikten sonra çalışmaz oldu. Çözemedim. Yardımcı olabilirmisiniz.


Sub TAKVİMEAKTAR()
Dim sh As Worksheet
Dim oOutLook As Object
Dim oRandevu As Object
Set sh = ActiveSheet
On Error Resume Next
Set oOutLook = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set oOutLook = CreateObject("Outlook.application")
End If
On Error GoTo 0

On Error Resume Next

For i = 6 To sh.[c65536].End(3).Row
Set oRandevu = oOutLook.CreateItem(olAppointmentItem)
With oRandevu
.Start = Cells(i, 3) + Cells(i, 4)
.End = Cells(i, 5) + Cells(i, 6)
.Subject = Cells(i, 7)
.Location = Cells(i, 8)
.Body = Cells(i, 9)
If Len(Cells(i, 10)) > 0 Then
If IsNumeric(Cells(i, 10)) Then
.ReminderMinutesBeforeStart = Cells(i, 10)
.ReminderSet = True
End If
End If

If Err <> 0 Then
Cells(i, 2) = "HATA"
Else
.Save
Cells(i, 2) = "OK"
Err = 0
End If
End With
Set oRandevu = Nothing
Next i

' oRandevu.Display
Set oOutLook = Nothing
Set sh = Nothing
Range("AK6:AK106").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-87
Range("AB6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B6").Select
End Sub
 
Katılım
20 Eylül 2005
Mesajlar
119
Excel Vers. ve Dili
2016 - Türkçe
Start = Cells(i, 3) + Cells(i, 4)
.End = Cells(i, 5) + Cells(i, 6)
.Subject = Cells(i, 7).Value
.Location = Cells(i, 8).Value
.Body = Cells(i, 9).Value
If Len(Cells(i, 10)) > 0 Then
If IsNumeric(Cells(i, 10)) Then
.ReminderMinutesBeforeStart = Cells(i, 10).Value
.ReminderSet = True


cells(x,x) den sona .value yazdım düzeldi.
 
Üst