Fuatckmk
Altın Üye
- Katılım
- 21 Aralık 2017
- Mesajlar
- 65
- Excel Vers. ve Dili
- Excel 365 - Türkçe
- Altın Üyelik Bitiş Tarihi
- 06-06-2025
Merhaba,
Aşağıda sürekli kullandığım bir makro var.
Makroda ilave olarak eklemek istediğim;
Standart klasörler mevcut ve bu klasörlerin içerisinde excel dosyaları oluşturuyorum. Bazen bazı klasörlerin içerisinde hiçbirşey oluşturmuyorum, fakat boş da olsa o klasör oluyor.
Olmasını istediğim klasörün içerisi boş ise maili göndermesin o satırı es geçsin.
Aşağıda bir kod yazılı fakat klasör boş olsa da mail gönderiyor, koddaki hata nerede? hata yok ise başka bir kod mu yazılmalı. Klasörün içerisi boş olduğu için boş mail gönderiyor. İstediğim boş maili de göndermesin. Hiçbirşey yapmasın.
Yardımlarınızı rica ederim.
Aşağıda sürekli kullandığım bir makro var.
Makroda ilave olarak eklemek istediğim;
Standart klasörler mevcut ve bu klasörlerin içerisinde excel dosyaları oluşturuyorum. Bazen bazı klasörlerin içerisinde hiçbirşey oluşturmuyorum, fakat boş da olsa o klasör oluyor.
Olmasını istediğim klasörün içerisi boş ise maili göndermesin o satırı es geçsin.
Aşağıda bir kod yazılı fakat klasör boş olsa da mail gönderiyor, koddaki hata nerede? hata yok ise başka bir kod mu yazılmalı. Klasörün içerisi boş olduğu için boş mail gönderiyor. İstediğim boş maili de göndermesin. Hiçbirşey yapmasın.
Yardımlarınızı rica ederim.
Kod:
Sub MAIL_GONDER()
Dim Outlook_App As Object
Dim Outlook_Mail As Object
Dim S1 As Worksheet, X As Long
Dim dosya, altdosyalar
Set Outlook_App = CreateObject("Outlook.Application")
Set S1 = Sheets("Sayfa1")
For X = 2 To S1.Cells(S1.Rows.Count, 1).End(3).Row
If S1.Cells(X, 6) = "" Then
Set Outlook_Mail = Outlook_App.CreateItem(0)
With Outlook_Mail
.display
.To = S1.Cells(X, 3)
.CC = S1.Cells(X, 4)
.Subject = S1.Cells(X, 2)
.HTMLBody = S1.Cells(X, 1) & .HTMLBody
dosya = S1.Cells(X, 5).Value
Dim say As Integer
For Each altdosyalar In CreateObject("scripting.filesystemobject").getfolder(dosya).Files
.Attachments.Add altdosyalar.Path
say = say + 1
Next
If say > 0 Then
'.Attachments.Add dosya
.Save
.send
S1.Cells(X, 6) = "Gönderildi."
MsgBox "Tamamlandı..", vbInformation
End If
End With
End If
Next
Set S1 = Nothing
Set Outlook_Mail = Nothing
Set Outlook_App = Nothing
End Sub