Soru Outlook VBA'da kodu Excel VBA da çalışacak şekilde uyarlamak.

[bulentkars]

Arkadaşlar Merhaba;

Aşağıdaki Kodu Outlook VBA da çalıştırdığımda Çıkışlar Klasörü içerindeki mailleri ek olarak kaydediyorum.
Bu kodu ben Excel VBA da çalıştırmak istiyorum. Mümkün mü acaba yardımcı olabilirseniz sevinirim.

Şimdiden Teşekkürler

Sub Mail_Dosya_Ekleri_Kaydet()

Dim ns As Outlook.Namespace
Dim inbox As Outlook.Folder
Dim reportFolder As Outlook.Folder
Dim item As Object
Dim att As Outlook.Attachment
Dim saveFolder As String
Dim fileName As String
Dim senderName As String
Dim filePath As String
Dim SelectedFolder As String
Dim dialog As FileDialog

Set ns = Application.GetNamespace("MAPI")
Set inbox = ns.GetDefaultFolder(olFolderInbox)

Set reportFolder = inbox.Folders("ÇIKIŞLAR")

SelectedFolder = "C:\Dosyalar\ " ' İstediğiniz klasörü buraya yazabilirsiniz

For Each item In reportFolder.Items
If item.Class = olMail Then

senderName = item.SenderEmailAddress
senderName = Split(senderName, "@")(0)


For Each att In item.Attachments
     If Right(att.fileName, 5) = ".xlsx" Or Right(att.fileName, 4) = ".xls" Then
          fileName = senderName & ".xlsx"
          filePath = SelectedFolder & "\" & fileName
          
          
    End If
    
att.SaveAsFile filePath
Next att
End If
Next item

MsgBox "E-posta ekleri kaydedildi.", vbInformation
End Sub

 

[tugkan]

Bu kodu Excel VBA’da kullanabilmeniz için küçük değişiklikler yaparak Excel’den Outlook’a erişimi sağlamalıyız. Aşağıdaki örnek, kodun Excel VBA’da çalıştırılabilmesi için uyarlanmış halidir:

1. Outlook nesnesi oluşturulmalı.


2. Referans ekleme yapılmalı (Excel VBA’da, Araçlar > Referanslar yolunu izleyerek "Microsoft Outlook XX.X Object Library" kutucuğunu işaretleyin).



Excel VBA Kod:

Sub Mail_Dosya_Ekleri_Kaydet()

Dim olApp As Object
Dim ns As Object
Dim inbox As Object
Dim reportFolder As Object
Dim item As Object
Dim att As Object
Dim saveFolder As String
Dim fileName As String
Dim senderName As String
Dim filePath As String
Dim SelectedFolder As String

' Outlook Uygulamasını Başlatma
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0

' Outlook Namespace ve Klasörleri Tanımlama
Set ns = olApp.GetNamespace("MAPI")
Set inbox = ns.GetDefaultFolder(6) ' 6: olFolderInbox sabiti

' Çıkışlar Klasörü
Set reportFolder = inbox.Folders("ÇIKIŞLAR")

' Kayıt Klasörü
SelectedFolder = "C:\Dosyalar" ' Kayıt yapılacak klasör

For Each item In reportFolder.Items
If item.Class = 43 Then ' 43: olMail sabiti

' Gönderenin ismini alma
senderName = item.SenderEmailAddress
senderName = Split(senderName, "@")(0)

' Ekleri kaydetme
For Each att In item.Attachments
If Right(att.fileName, 5) = ".xlsx" Or Right(att.fileName, 4) = ".xls" Then
fileName = senderName & "_" & att.fileName
filePath = SelectedFolder & "\" & fileName
att.SaveAsFile filePath
End If
Next att
End If
Next item

MsgBox "E-posta ekleri kaydedildi.", vbInformation
End Sub

Açıklama:

Kod, Outlook’u Excel VBA içinden başlatır ve Çıkışlar klasöründeki maillerin eklerini belirtilen klasöre kaydeder.

SelectedFolder değişkenini kendi klasör yolunuza göre güncelleyebilirsiniz.



Bu haliyle Excel’den çalıştırarak e-posta eklerini kaydedebilirsiniz.

 

[bulentkars]

Çok Teşekkürler elinize emeğinize sağlık

 

[tugkan]

Çalıştıysa bir beğeninizi alırım artık

 

[bulentkars]

Allah razı olsun sizden

 

[tugkan]

Amin cümlemizden