• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

outlook mail gönderme sorunu

Katılım
14 Ekim 2017
Mesajlar
26
Excel Vers. ve Dili
excel 2016
merhaba

excelde 2 sayfam var.

sayfa 1'in a2 hücresindeki değer sayfa2nin a2 değerindeki hücreye eşitse,sayfa 2 b2 hücresindeki mail adresine belirlediğim maili gönderiyor.

fakat;

sayfa1 deki a2 hücresinin değeri sayfa 2 de a5 hücresindeyse eğer göndermiyor.

yani hücre numaraları eşit ise gödneriyor.ben istiyorumki sayfa 2 deki a sütununa tamamen baksın ve eşit olanı varsa göndersin.nasıl yapabilirim.

Kod:
Sub maliisler()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
For esitse = 2 To s1.Cells(Rows.Count, 1).End(xlUp).Row
If s1.Cells(esitse, 1) = s2.Cells(esitse, 1) And s2.Cells(esitse, 2) <> "" Then
   Dim OutApp As Object
   Dim OutMail As Object
   With Application
       .EnableEvents = False
       .ScreenUpdating = False
   End With
   Set OutApp = CreateObject("Outlook.Application")
   Set OutMail = OutApp.CreateItem(0)
   On Error Resume Next
    kime = s2.Cells(esitse, 2) & ";" & s2.Cells(esitse, 3)
    bilgi = ""
    msg = "Merhaba" & Chr(13) & Chr(13) & "Ekteki mutabakat mektubuna dönüsünüzü rica ederiz." & Chr(13) & Chr(13) & "Saygilarimizla" & Chr(13)
   With OutMail
       .To = kime
       .CC = bilgi
       .BCC = ""
       .Subject = "Başlık"
       .Body = msg
       firma = s1.Cells(esitse, 1)
       vergino = s1.Cells(esitse, 2)
       tc = s1.Cells(esitse, 3)
       adet = s1.Cells(esitse, 4)
       tutar = s1.Cells(esitse, 5)
       Sheets("Sayfa4").Select
       Range("b9") = firma
       Range("c9") = vergino
       Range("d9") = tc
       Range("e9") = adet
       Range("f9") = tutar
       ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
       Filename:="C:\Users\dosyayolu\Desktop\Mutabakat Mektubu.pdf"
       .Attachments.Add ("C:\Users\dosyayolu\Desktop\Mutabakat Mektubu.pdf")
       .Display
       .send
   End With
   On Error GoTo 0
   Set OutMail = Nothing
   Set OutApp = Nothing

     With Application
       .EnableEvents = True
       .ScreenUpdating = True
   End With
   s1.Cells(esitse, 6) = "Gönderildi"
  
   With s1.Cells(esitse, 6).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    Else
    s1.Cells(esitse, 6) = "Gönderilmedi"
       With s1.Cells(esitse, 6).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End If
Next esitse
Sheets("Sayfa1").Select
End Sub
 
Kodlardaki,
If s1.Cells(esitse, 1) = s2.Cells(esitse, 1) And s2.Cells(esitse, 2) <> "" Then
satırını
If s1.Cells(2, 1) = s2.Cells(esitse, 1) And s2.Cells(esitse, 2) <> "" Then

şeklinde değiştirerek deneyin.
 
Kodlardaki,
If s1.Cells(esitse, 1) = s2.Cells(esitse, 1) And s2.Cells(esitse, 2) <> "" Then
satırını
If s1.Cells(2, 1) = s2.Cells(esitse, 1) And s2.Cells(esitse, 2) <> "" Then

şeklinde değiştirerek deneyin.

teşekkür ederim.
 
Geri
Üst