Dış işlemler ile makro çalıştırmak

[Hüseyin Çoban]

Merhaba Arkadaşlar,

Excelde makroları buton, bazı işlemlem ve komutlar ile çalıştırabiliyoruz.

Ancak makroları çalıştırmak için diğer dış işlemleri araştırıyorum.
İlk olarak Mic. Outlooka gelen bir maille excel çalışmamızdaki makroyu çalıştıra bilmemiz mümkün mü?

Yardım ve fikirlerinizi bekliyorum.

[Bülent Öztürk]

Merhaba Hüseyin Bey.

MsOutlook'un ThisOutlookSession'una aşağıdaki kodları yazıp, yeni mail geldiğinde dilediğiniz Excel kitabını açtırabilirsiniz.

Kod: [Seç]

Private Sub Application_NewMail()
Dim OUT As NameSpace
Set OUT = Outlook.GetNamespace("MAPI")
Dim Gelenler As Outlook.MAPIFolder
Set Gelenler = OUT.GetDefaultFolder(olFolderInbox)
If Gelenler.Items(Gelenler.Items.Count).Subject = "Deneme" Then
    Set Excelce = Application.CreateObject("Excel.Application")
    Excelce.Visible = True
    Set Kitap = Excelce.Workbooks.Open("C:\Documents and Settings\bulent.ozturk\Desktop\Kitap1.xls")
    Excelce.Run "Kitap1.xls!Makro1"

    'Diğer işlemler...
    'Excel'i kapatmak isterseniz
    Excelce.Quit
   End If
End Sub


[Hüseyin Çoban]

İlginiz ve paylaşımınız için teşekkürler Bülent Bey,

Kodları McOutlook' a uygulattım. İlk denemelerimde

Kod: [Seç]

If Gelenler.Items(Gelenler.Items.Count).Subject = "Deneme" Thensatırında hatalar vermişti.

Ancak şimdiki denemlerimde işlemi hiç çalıştırmıyor. Son denememde dosya yolunu değiştirmeden denedim çalışmadı, hatada vermedi.

[Bülent Öztürk]

Hüseyin Bey,

If Gelenler.Items(Gelenler.Items.Count).Subject = "Deneme" Then

komut satırı ile Gelen Kutusu (Inbox)'nun son öğesini Gelenler.Items.Count ile bulup,
Gelenler.Items'in index'ine yazıp, Subject ile başlığına bakma şartını IF ile koyarak, başlığın Deneme olması halinde belirtilen kodların çalışmasını sağlıyoruz.

Yukarıdaki kodları Application_NewMail olayına yazdığımız için de her yeni mail geldiğinde Outlook'un kodları çalıştırmasını sağlamış olduk.

Kodları deneyip gönderdiğim için ben çalışmasında sorun yaşamadım.

Tekrar deneyip, hata verdiğinde resmini ekler misiniz?

[Hüseyin Çoban]

Bülent Bey, kodları ilk uyguladığımda hata uyarısı alıyordum, şimdi öyle bir hata uyarısıda vermiyor. Sanırım işlemi hiç tetiklemiyor.

[Bülent Öztürk]

Siz hangi şarta bağlı olarak kodun çalışmasını istiyorsunuz?

Outlook içinden kodu, F8 ile adım adım çalıştırıp deneyin...

Kod: [Seç]

Set Kitap = Excelce.Workbooks.Open("C:\Documents and Settings\bulent.ozturk\Desktop\Kitap1.xls")   
Excelce.Run "Kitap1.xls!Makro1"

Dosya adı, yolu ve makro adlarını uyarlamayı unutmayın.

[Hüseyin Çoban]

Bülent Bey,
Şartlara uygun en son gelen mail ile işlemi çalıştırmalı.
Kodları şu şekilde düzenleyerek uygulattım. Hataya gidince sarı ile belirttiğim satıra gidiyor.

Deneme başlıklı bir mail atıyorum, ekteki hatayı veriyor. Hatayı kapatıp Deneme1 başlıklı bir mail daha atıyorum, işlem çalışıyor.   

Private Sub Application_NewMail()
Dim OUT As NameSpace
Set OUT = Outlook.GetNamespace("MAPI")
Dim Gelenler As Outlook.MAPIFolder
Set Gelenler = OUT.GetDefaultFolder(olFolderInbox)
If Gelenler.Items(Gelenler.Items.Count).Subject = "Deneme" Then
    Set Excelce = Application.CreateObject("Excel.Application")
    Excelce.Visible = True
    Set Kitap = Excelce.Workbooks.Open("D:\Kitap1.xls")
    Excelce.Run "Kitap1.xls!Sayfa1.Makro1"

    'Diğer işlemler...
    'Excel'i kapatmak isterseniz
    Excelce.Quit
   End If
End Sub

[Bülent Öztürk]

Gelen Kutusu içinde sadece 1 adet mail varken mi sorun oluyor?

[Hüseyin Çoban]

Deneme mailini alınca hata veriyor, hatayı kapatıyorum.
Deneme1 veya Deneme2 diye tekrar mail atınca işlemi çalıştırıyor.

[Bülent Öztürk]

Şu şekilde dener misiniz?

Private Sub Application_NewMail()
Dim OUT As NameSpace
Set OUT = Outlook.GetNamespace("MAPI")
Dim Gelenler As Outlook.MAPIFolder
Set Gelenler = OUT.GetDefaultFolder(olFolderInbox)
On Error GoTo bir
If Gelenler.Items(Gelenler.Items.Count).Subject = "Deneme" Then
    Set Excelce = Application.CreateObject("Excel.Application")
    Excelce.Visible = True
    Set Kitap = Excelce.Workbooks.Open("C:\Documents and Settings\bulent.ozturk\Desktop\Kitap1.xls")
    Excelce.Run "Kitap1.xls!Makro1"
    'Excel'i kapatmak isterseniz
    Excelce.Quit
End If
Exit Sub
bir:
If Gelenler.Items(1).Subject = "Deneme" Then
    Set Excelce = Application.CreateObject("Excel.Application")
    Excelce.Visible = True
    Set Kitap = Excelce.Workbooks.Open("C:\Documents and Settings\bulent.ozturk\Desktop\Kitap1.xls")
    Excelce.Run "Kitap1.xls!Makro1"
    'Excel'i kapatmak isterseniz
    Excelce.Quit
End If
End Sub

[Hüseyin Çoban]

Bülent Bey, aynı hata kodunu verdi. Ancak yine arkasından Deneme1 diye mail atınca işlemi çalıştırdı. 

If Gelenler.Items(1).Subject = "Deneme" Then

satırında hata verdi.

[Bülent Öztürk]

Bir de şöyle deneyelim:

Private Sub Application_NewMail()
Dim OUT As NameSpace
Set OUT = Outlook.GetNamespace("MAPI")
Dim Gelenler As Outlook.MAPIFolder
Set Gelenler = OUT.GetDefaultFolder(olFolderInbox)
On Error GoTo bir
If Gelenler.Items(Gelenler.Items.Count).Subject = "Deneme" Then
    Set Excelce = Application.CreateObject("Excel.Application")
    Excelce.Visible = True
    Set Kitap = Excelce.Workbooks.Open("C:\Documents and Settings\bulent.ozturk\Desktop\Kitap1.xls")
    Excelce.Run "Kitap1.xls!Makro1"
    'Excel'i kapatmak isterseniz
    Excelce.Quit
End If
Exit Sub
bir:
On Error Resume Next
If Gelenler.Items(1).Subject = "Deneme" Then
    Set Excelce = Application.CreateObject("Excel.Application")
    Excelce.Visible = True
    Set Kitap = Excelce.Workbooks.Open("C:\Documents and Settings\bulent.ozturk\Desktop\Kitap1.xls")
    Excelce.Run "Kitap1.xls!Makro1"
    'Excel'i kapatmak isterseniz
    Excelce.Quit
End If
End Sub

[Hüseyin Çoban]

Bülent Bey, gene aynı işlemler ile çalışıyor.
Siz denediğinizde ilk deneme başlıklı mail ile işlemi çalıştırıyor mu ?

[Bülent Öztürk]

Gelen kutusunda mail varken denedim, sorunsuz çalıştı.

Mailleri taşıyıp denedim, hata verdi.
Sonra diğer kodu yazınca hata vermedi.


Kodları Application_NewMailEx  olayına taşıyıp dener misiniz?

[Hüseyin Çoban]

Bende de gelen kutusunda bir tane Deneme başlıklı mail olduktan sonra,
içerisinde Deneme geçen bir başlık yazıp gönderince çalıştırıyor işlemi.