Excel Vba Forum - Excelce.Net
SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Çözülen Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: Hüseyin Çoban - 03 Ocak 2011, 09:13:14
-
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.
-
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.
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
-
İlginiz ve paylaşımınız için teşekkürler Bülent Bey,
Kodları McOutlook' a uygulattım. İlk denemelerimde
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.
-
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?
-
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.
(http://img411.imageshack.us/img411/8750/excelce2.jpg)
(http://img835.imageshack.us/img835/9883/excelce1.jpg)
-
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...
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.
-
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. :hımm
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
(http://img338.imageshack.us/img338/5255/excel3.jpg)
-
Gelen Kutusu içinde sadece 1 adet mail varken mi sorun oluyor?
-
Deneme mailini alınca hata veriyor, hatayı kapatıyorum.
Deneme1 veya Deneme2 diye tekrar mail atınca işlemi çalıştırıyor.
-
Ş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
-
Bülent Bey, aynı hata kodunu verdi. Ancak yine arkasından Deneme1 diye mail atınca işlemi çalıştırdı. :hımm
If Gelenler.Items(1).Subject = "Deneme" Then
satırında hata verdi.
-
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
-
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 ?
-
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?
-
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.
-
Kodları Application_NewMailEx olayına taşıyıp denediniz mi??
-
Kodları Application_NewMailEx olayına taşıyıp denediniz mi??
Evet Bülent Bey denedim bir değişiklik olmadı.
-
Hımm... :hımm
Kodların en başına
On Error Resume Next
satırı ekleyin, son çare olarak...
-
Bütün çareler çaresiz Hocam, hâlâ aynı ilginç hata devam ediyor.
-
On error resume next
yazdığınız halde mi hata veriyor?
Bende şu an sorunsuz çalışıyor.
-
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
On Error Resume Next
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("D:\Kitap1.xls")
Excelce.Run "Kitap1.xls!Sayfa1.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("D:\Kitap1.xls")
Excelce.Run "Kitap1.xls!Sayfa1.Makro1"
'Excel'i kapatmak isterseniz
Excelce.Quit
End If
End Sub
Kendi dosya yollarıma ve örnek dosyaya göre kodların uyarladığım son şekli bu Hocam.
Ancak hâlâ ilk mailde hata veriyor.
Rica etsen Bülent Bey uygun bir anınızda TeamViewer veya vb. bir programda bağlanıp kontrol edebilir misiniz?
-
Şu şekilde deneyin bakalım bir netice alacak mısınız?
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim OUT As NameSpace
Set OUT = Outlook.GetNamespace("MAPI")
Dim Gelenler As Outlook.MAPIFolder
Set Gelenler = OUT.GetDefaultFolder(olFolderInbox)
On error resume next
MsgBox Gelenler.Items(Gelenler.Items.Count).Subject
End Sub
-
Gelen kutusu boş olursa çalışmıyor.
Gelen kutusunda yeni veya eski bir mail olunca çalışıyor.
Bir önceki mailin başlığını msgbox ile veriyor.
-
Yeni mail geldiği halde, gelen kutusuna düşmeden önce kod çalışıyor demek ki... :hımm
Ben 2003 versiyon Outlook'ta kullandığımda mail geldiği anda, en son gelen mailin başlığını mesaj olarak görüntülüyorum.
Versiyon farkından da böyle bir fark olmaması gerekir.
Yine de evde 2007'de deneyeyim bakalım...
-
Hüseyin Bey, şu kod ile nasıl bir netice alıyorsunuz?
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim OUT As NameSpace
Set OUT = Outlook.GetNamespace("MAPI")
Dim Gelenler As Outlook.MAPIFolder
Set Gelenler = OUT.GetDefaultFolder(olFolderInbox)
On error resume next
If Gelenler.Items(Gelenler.Items.Count).UnRead = True Then MsgBox Gelenler.Items(Gelenler.Items.Count).Subject
End Sub
-
Merhaba Bülent Bey,
İlk mail geldiğin ekteki hata mesajı geliyor (Resim 1). End butonunu tıklayıp hatayı kapattıktan sonra, ikinci mail geldiğinde Msgboxda ilk gelen mailin başlığını yazıyor. (Resim 2)
Hata mesajında koda gittiğimde
"If Gelenler.Items(Gelenler.Items.Count).UnRead = True Then" satırını sarıya boyuyor.
(http://img221.imageshack.us/img221/7050/84730660.jpg)
(http://img192.imageshack.us/img192/6148/96212721.jpg)
-
Size zahmet bir de şunu deneyin:
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim OUT As NameSpace
Set OUT = Outlook.GetNamespace("MAPI")
Dim Gelenler As Outlook.MAPIFolder
Set Gelenler = OUT.GetDefaultFolder(olFolderInbox)
Dim ilksayi As Integer
ilksayi = Gelenler.Items.Count
While Gelenler.Items.Count = ilksayi
Wend
MsgBox Gelenler.Items(Gelenler.Items.Count).Subject
End sub
-
Bülent Bey, asıl ben size zahmetler veriyorum.
Kodları uygulattım, yeni bir mail geldiğinde Outlook'u kilitliyor. İşlemi sonlandırmak zorunda kaldım.
-
İşlemi tekrar denedim, bu sefer sonuna kadar bekledim.
Ekteki hata mesajını verdi.
(http://img209.imageshack.us/img209/9342/37522081.jpg)
-
Evet, sonsuz göngüye giriyor... :hımm
Sanırım doğrudan Outlook içinden bunu halledemeyeceğiz.
Kodlar, yeni mail kutuya düşmeden çalıştığı için son gelen/gelmekte olan mail hakkında bilgi alamıyoruz. :hımm
-
Merhaba Hüseyin Bey,
Makrosuz, Outlook özellikleri dahilinde bir çözüm var sanırım.
Resimlerle anlatmaya çalıştım.
Dener misiniz?
(Ekler güncellenmiştir-14.08.2011)
-
İlgi ve emekleriniz için teşekkür ederim Bülent Bey, denemedim sorunsuz çalışıyor. :begendim
Paylaşımı hemen arşivime ekliyorum, her zaman bulunması gereken bir çalışma. :alkis
(Ekler güncellenmiştir-14.08.2011)
-
Rica ederim. ;)
Outlook makro olaylarının sınırlı olması, KURALLAR VE UYARILAR özelliğinin oldukça geniş kapsamlı olmasından dolayı sanırım. :)
Çalışmalarınızda başarılar.