İlgili Satır Boşsa Es Geç

F

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.


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
 
P

PLİNT

Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Fuatckmk' Alıntı:
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.
Genişletmek için tıkla ...
Merhaba
Aşağıdaki gibi deneyin
Klasörün içindeki dosya sayısına bakacak "0" dan fazla ise dosya formatına bakmadan ekleyecek.
Kod: 
[SIZE="2"]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
     [COLOR="Blue"]   dosya = S1.Cells(X, 5).Value[/COLOR]
[COLOR="Red"]  If CreateObject("Scripting.FileSystemObject").GetFolder(dosya).Files.Count > 0 Then[/COLOR]
            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
                
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
        [COLOR="Red"]End If[/COLOR]: End If
    Next  
    Set S1 = Nothing
    Set Outlook_Mail = Nothing
    Set Outlook_App = Nothing
  
End Sub[/SIZE]
 
F

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
PLİNT' Alıntı:
Merhaba
Aşağıdaki gibi deneyin
Klasörün içindeki dosya sayısına bakacak "0" dan fazla ise dosya formatına bakmadan ekleyecek.
Kod: 
[SIZE="2"]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
     [COLOR="Blue"]   dosya = S1.Cells(X, 5).Value[/COLOR]
[COLOR="Red"]  If CreateObject("Scripting.FileSystemObject").GetFolder(dosya).Files.Count > 0 Then[/COLOR]
            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
                
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
        [COLOR="Red"]End If[/COLOR]: End If
    Next  
    Set S1 = Nothing
    Set Outlook_Mail = Nothing
    Set Outlook_App = Nothing
  
End Sub[/SIZE]
Genişletmek için tıkla ...
Hocam mükemmelsiniz, teşekkürler
 
F

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
PLİNT' Alıntı:
Merhaba
Aşağıdaki gibi deneyin
Klasörün içindeki dosya sayısına bakacak "0" dan fazla ise dosya formatına bakmadan ekleyecek.
Kod: 
[SIZE="2"]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
     [COLOR="Blue"]   dosya = S1.Cells(X, 5).Value[/COLOR]
[COLOR="Red"]  If CreateObject("Scripting.FileSystemObject").GetFolder(dosya).Files.Count > 0 Then[/COLOR]
            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
                
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
        [COLOR="Red"]End If[/COLOR]: End If
    Next  
    Set S1 = Nothing
    Set Outlook_Mail = Nothing
    Set Outlook_App = Nothing
  
End Sub[/SIZE]
Genişletmek için tıkla ...

Merhabalar tekrardan,

İlgili makroya mail gönderdikten sonra dosyayı silsin diye bir ekleme yapmaya çalıştım fakat birtürlü başaramadım.

Kill kodunu kullandım olmadı. Yardımcı olabilir misiniz?
 
F

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
Güncel....
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst