Excel Sayfasını Mail Olarak Gönderme

s4kinqz

s4kinqz

Katılım
28 Aralık 2020
Mesajlar
33
Excel Vers. ve Dili
excel 2016, Türkçe
Altın Üyelik Bitiş Tarihi
28-12-2021
Merhaba Arkadaşlar,

Makro öğrenmeye yeni başladım. işime yarayabilecek bir dosya yapmaya çalışıyorum fakat bir yerde tıkandım. Site üzerinden de kontrol ettim fakat her denemem başarısız oldu.

Örnek dosyada ki gibi bir süz işlemi yaptım ve süzden sonra o tuşa atanacak olan mail adresine süzülen sayfanın gitmesini istiyorum.

Teşekkürler
 

Ekli dosyalar

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,160
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Kodun içine açıklamalar yazdım.

Uygun şekilde tanımlamalar yaparak kullanabilirsiniz.

C++: 
Option Explicit

Sub Filtrelenmiş_Verileri_Mail_Gonder()
    Dim S1 As Worksheet, Uygulama As Object, Yeni_Mail As Object
    Dim Dosya_Adi As String, Mesaj As String
   
    Set S1 = Sheets("Sheet1")
   
    Dosya_Adi = ThisWorkbook.Path & "\Dosya_Adi.xlsx"

    With S1
        .Range("A1:C" & .Rows.Count).AutoFilter Field:=1, Criteria1:="satın alma"
        .Range("A1").CurrentRegion.Copy
    End With
   
    Workbooks.Add (1)
    ActiveSheet.Paste
    Columns.AutoFit
    Range("A1").Select
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Dosya_Adi, 51
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
   
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
   
    On Error Resume Next
    Set Uygulama = GetObject(, "Outlook.Application")
    On Error GoTo 0
   
    If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)
   
    Set Uygulama = CreateObject("Outlook.Application")
    Set Yeni_Mail = Uygulama.CreateItem(0)
   
    Mesaj = "Merhaba," & "<br><br>" & "Mail gövdesinde görmek istediniz mesajı buraya yazınız." & "<br><br>" & _
            "İyi çalışmalar dileriz."
   
    Mesaj = "<p style='color:black;font-family:Arial;font-size:13.5'>" & Mesaj & "</font></p>"
   
    With Yeni_Mail
        .Display
        .To = "Göndermek istediğiniz mail adresini yazınız."
        .Cc = ""
        .Bcc = ""
        .Subject = "Mail konusunu buraya yazınız."
        .HTMLBody = Mesaj & .HTMLBody
        .Attachments.Add Dosya_Adi
        .BodyFormat = 2
        .Save
        .Send
    End With
   
    Set S1 = Nothing
    Set Yeni_Mail = Nothing
    Set Uygulama = Nothing
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
s4kinqz

s4kinqz

Katılım
28 Aralık 2020
Mesajlar
33
Excel Vers. ve Dili
excel 2016, Türkçe
Altın Üyelik Bitiş Tarihi
28-12-2021
Korhan Ayhan' Alıntı:
Kodun içine açıklamalar yazdım.

Uygun şekilde tanımlamalar yaparak kullanabilirsiniz.

C++: 
Option Explicit

Sub Filtrelenmiş_Verileri_Mail_Gonder()
    Dim S1 As Worksheet, Uygulama As Object, Yeni_Mail As Object
    Dim Dosya_Adi As String, Mesaj As String
  
    Set S1 = Sheets("Sheet1")
  
    Dosya_Adi = ThisWorkbook.Path & "\Dosya_Adi.xlsx"

    With S1
        .Range("A1:C" & .Rows.Count).AutoFilter Field:=1, Criteria1:="satın alma"
        .Range("A1").CurrentRegion.Copy
    End With
  
    Workbooks.Add (1)
    ActiveSheet.Paste
    Columns.AutoFit
    Range("A1").Select
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Dosya_Adi, 51
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
  
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
  
    On Error Resume Next
    Set Uygulama = GetObject(, "Outlook.Application")
    On Error GoTo 0
  
    If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)
  
    Set Uygulama = CreateObject("Outlook.Application")
    Set Yeni_Mail = Uygulama.CreateItem(0)
  
    Mesaj = "Merhaba," & "<br><br>" & "Mail gövdesinde görmek istediniz mesajı buraya yazınız." & "<br><br>" & _
            "İyi çalışmalar dileriz."
  
    Mesaj = "<p style='color:black;font-family:Arial;font-size:13.5'>" & Mesaj & "</font></p>"
  
    With Yeni_Mail
        .Display
        .To = "Göndermek istediğiniz mail adresini yazınız."
        .Cc = ""
        .Bcc = ""
        .Subject = "Mail konusunu buraya yazınız."
        .HTMLBody = Mesaj & .HTMLBody
        .Attachments.Add Dosya_Adi
        .BodyFormat = 2
        .Save
        .Send
    End With
  
    Set S1 = Nothing
    Set Yeni_Mail = Nothing
    Set Uygulama = Nothing
  
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...
Teşekkür ederim Korhan bey, her filtre için yeni bir modul açıp bu kodu değiştirmem gerekiyor sanırım ?
With S1
.Range("A1:C" & .Rows.Count).AutoFilter Field:=1, Criteria1:="satın alma"
.Range("A1").CurrentRegion.Copy
End With
Genişletmek için tıkla ...
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,160
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Tabi ki hayır.

Bahsettiğiniz yöntem çok yanlış bir yöntemdir.

Bunun yerine filtre kriterini veri doğrulama-liste özelliği olan bir hücreye bağlayabilirsiniz.
 
s4kinqz

s4kinqz

Katılım
28 Aralık 2020
Mesajlar
33
Excel Vers. ve Dili
excel 2016, Türkçe
Altın Üyelik Bitiş Tarihi
28-12-2021
Korhan Ayhan' Alıntı:
Tabi ki hayır.

Bahsettiğiniz yöntem çok yanlış bir yöntemdir.

Bunun yerine filtre kriterini veri doğrulama-liste özelliği olan bir hücreye bağlayabilirsiniz.
Genişletmek için tıkla ...
Anladım Korhan bey desteğiniz için teşekkür ederim.
 
O

omarpz

Katılım
4 Ocak 2021
Mesajlar
22
Excel Vers. ve Dili
Microsoft Excel 2016 MSO 16.0.4266.1001 Türkçe
Benim bir makrom var. Kişileri filtreliyorum ve tablo olarak gönderiyorum. Fakat bunu excel olarak göndermek istiyorum. Aşağıdaki koda uygun bir şekilde düzenleyebilir misiniz?


Sub Makro1()
'
' Makro1 Makro
'
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set rng = Nothing
Set rng = Sheets("VERİ").UsedRange
'You can also use a sheet name
'Set rng = Sheets("YourSheet").UsedRange

Metin = "<span LANG=EN>" _
& "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
& "Merhaba " & Sheets("ANA SAYFA").Range("C1").Value & "," & "<br>" _
& "<br>" _
& vbCrLf & Sheets("ANA SAYFA").Range("J3").Value & "<br> " _
& "<br>" _
& vbCrLf & Sheets("ANA SAYFA").Range("J5").Value & "<br> " _
& "<br>" _
& vbCrLf & Sheets("ANA SAYFA").Range("J7").Value & "<br> " _
& "<br>" _
& vbCrLf & Sheets("ANA SAYFA").Range("J9").Value & "<br> " _
& "<br>" _
& vbCrLf & Sheets("ANA SAYFA").Range("J11").Value & "<br> " _
& xSrc _
& "<br></font></span>"

Metin2 = "<span LANG=EN>" _
& "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
& "İyi Çalışmalar." & "<br>" _
& xSrc _
& "<br></font></span>"

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.Display
.To = Sheets("ANA SAYFA").Range("B1").Value
.Cc = ""
.Bcc = ""
.Subject = Sheets("ANA SAYFA").Range("J1").Value
.HTMLBody = Metin & RangetoHTML(rng) & Metin2 & .HTMLBody
.Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,160
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
#2 nolu mesajımda paylaştığım kod zaten sizin istediğiniz işlemi yapıyor. Sadece kendinize göre uyarlamasını yapacaksınız.
 
O

omarpz

Katılım
4 Ocak 2021
Mesajlar
22
Excel Vers. ve Dili
Microsoft Excel 2016 MSO 16.0.4266.1001 Türkçe
Korhan Ayhan' Alıntı:
#2 nolu mesajımda paylaştığım kod zaten sizin istediğiniz işlemi yapıyor. Sadece kendinize göre uyarlamasını yapacaksınız.
Genişletmek için tıkla ...
yapamadığımdan dolayı destek istemiştim aslında. Belirttiğim kodlara sadece tablo olarak değilde ek olarak gönderilmesi konusunda yardımcı olur musunuz?
 
O

omarpz

Katılım
4 Ocak 2021
Mesajlar
22
Excel Vers. ve Dili
Microsoft Excel 2016 MSO 16.0.4266.1001 Türkçe
omarpz' Alıntı:
Benim bir makrom var. Kişileri filtreliyorum ve tablo olarak gönderiyorum. Fakat bunu excel olarak göndermek istiyorum. Aşağıdaki koda uygun bir şekilde düzenleyebilir misiniz?


Sub Makro1()
'
' Makro1 Makro
'
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set rng = Nothing
Set rng = Sheets("VERİ").UsedRange
'You can also use a sheet name
'Set rng = Sheets("YourSheet").UsedRange

Metin = "<span LANG=EN>" _
& "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
& "Merhaba " & Sheets("ANA SAYFA").Range("C1").Value & "," & "<br>" _
& "<br>" _
& vbCrLf & Sheets("ANA SAYFA").Range("J3").Value & "<br> " _
& "<br>" _
& vbCrLf & Sheets("ANA SAYFA").Range("J5").Value & "<br> " _
& "<br>" _
& vbCrLf & Sheets("ANA SAYFA").Range("J7").Value & "<br> " _
& "<br>" _
& vbCrLf & Sheets("ANA SAYFA").Range("J9").Value & "<br> " _
& "<br>" _
& vbCrLf & Sheets("ANA SAYFA").Range("J11").Value & "<br> " _
& xSrc _
& "<br></font></span>"

Metin2 = "<span LANG=EN>" _
& "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
& "İyi Çalışmalar." & "<br>" _
& xSrc _
& "<br></font></span>"

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.Display
.To = Sheets("ANA SAYFA").Range("B1").Value
.Cc = ""
.Bcc = ""
.Subject = Sheets("ANA SAYFA").Range("J1").Value
.HTMLBody = Metin & RangetoHTML(rng) & Metin2 & .HTMLBody
.Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Genişletmek için tıkla ...
yardımcı olur musunuz?
 
O

omarpz

Katılım
4 Ocak 2021
Mesajlar
22
Excel Vers. ve Dili
Microsoft Excel 2016 MSO 16.0.4266.1001 Türkçe
Korhan bey, hazırlamış olduğum makroya sadece excel olarak kaydet ve gönder kısmını nasıl ekleyebilirim?
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,160
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Örnek dosyanızı paylaşınız.
 
O

omarpz

Katılım
4 Ocak 2021
Mesajlar
22
Excel Vers. ve Dili
Microsoft Excel 2016 MSO 16.0.4266.1001 Türkçe
Korhan bey desteğinizi rica ederim
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,160
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Tablo olarak mail gövdesine eklenme durumu iptal mi olacak?
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,160
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Mail gönderimi için sadece bu kodu kullanabilirsiniz. Diğerlerine ihtiyacınız kalmamış oldu.

Kodun içindeki '.Send satırının başındaki tek tırnağı kaldırırsanız mailler direkt olarak gönderilir. Ben oluşan mailleri görebilmeniz için pasif bıraktım.

C++: 
Option Explicit

Sub Filtrelenmiş_Verileri_Mail_Gonder()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Uygulama As Object, Yeni_Mail As Object
    Dim Veri As Variant, X As Long, Son As Long
    Dim Dosya_Adi As String, Mesaj As String
   
    Set S1 = Sheets("ANA SAYFA")
    Set S2 = Sheets("VERİ")
    Set S3 = Sheets("ARA VERİLER")
    
    On Error Resume Next
    Set Uygulama = GetObject(, "Outlook.Application")
    On Error GoTo 0
    
    If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)
   
    Set Uygulama = CreateObject("Outlook.Application")
    
    Son = S3.Cells(S3.Rows.Count, 1).End(3).Row
    If Son < 3 Then Son = 3
    
    Veri = S3.Range("A2:C" & Son).Value
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 1) <> "" Then
        
            With S2
                .Range("A1:E" & .Rows.Count).AutoFilter Field:=1, Criteria1:=Veri(X, 1)
                .Range("A1").CurrentRegion.Copy
            End With
   
            Workbooks.Add (1)
            ActiveSheet.Paste
            Columns.AutoFit
            Range("A1").Select
            
            Application.DisplayAlerts = False
            Dosya_Adi = ThisWorkbook.Path & Application.PathSeparator & Veri(X, 1) & ".xlsx"
            ActiveWorkbook.SaveAs Dosya_Adi, 51
            ActiveWorkbook.Close
            Application.DisplayAlerts = True
            
            On Error Resume Next
            S2.ShowAllData
            On Error GoTo 0
            
            Set Yeni_Mail = Uygulama.CreateItem(0)
                   
            Mesaj = "Merhaba " & Veri(X, 1) & "," & "<br><br>" & S1.Range("J3").Value & "<br>" & _
                    "<br>" & S1.Range("J5").Value & "<br>" & _
                    "<br>" & S1.Range("J7").Value & "<br>" & _
                    "<br>" & S1.Range("J9").Value & "<br>" & _
                    "<br>" & S1.Range("J11").Value & "<br><br>" & _
                    "İyi çalışmalar."
   
            Mesaj = "<p style='color:black;font-family:Calibri;font-size:13.5'>" & Mesaj & "</font></p>"
   
            With Yeni_Mail
                .Display
                .To = Veri(X, 3)
                .Cc = "pivazovski@hotmail.com"
                .Bcc = ""
                .Subject = S1.Range("J1").Value
                .HTMLBody = Mesaj & .HTMLBody
                .Attachments.Add Dosya_Adi
                .BodyFormat = 2
                .Save
                '.Send
            End With
        End If
    Next
   
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set Yeni_Mail = Nothing
    Set Uygulama = Nothing
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
O

omarpz

Katılım
4 Ocak 2021
Mesajlar
22
Excel Vers. ve Dili
Microsoft Excel 2016 MSO 16.0.4266.1001 Türkçe
Elinize sağlk korhan bey
 
O

omarpz

Katılım
4 Ocak 2021
Mesajlar
22
Excel Vers. ve Dili
Microsoft Excel 2016 MSO 16.0.4266.1001 Türkçe
Korhan bey tekrardan merhaba,

yaptığınız kod gayet sağlıklı çalışıyor bunun için teşekkür ederim.

Ek olarak exceli maile ekledikten sonra masaüstünden silsin istiyorum.

Ayrıca mail başlangıcı merhaba “kullanıcı adı” şeklinde oluyor. Sayfa 3de a sütununda kullanıcı adlarının kime ait olduğu b sütununda yer alıyor. Mail başlangıcı Merhaba “ İsim “ şeklinde olması mümkün müdür?
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,160
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Sayfa3 dediğiniz sanırım "ARA VERİLER" isimli sayfa oluyor.

Deneyiniz.

C++: 
Option Explicit

Sub Filtrelenmiş_Verileri_Mail_Gonder()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Uygulama As Object, Yeni_Mail As Object
    Dim Veri As Variant, X As Long, Son As Long
    Dim Dosya_Adi As String, Mesaj As String
  
    Set S1 = Sheets("ANA SAYFA")
    Set S2 = Sheets("VERİ")
    Set S3 = Sheets("ARA VERİLER")
   
    On Error Resume Next
    Set Uygulama = GetObject(, "Outlook.Application")
    On Error GoTo 0
   
    If Uygulama Is Nothing Then Call Shell("Outlook.exe", vbHide)
  
    Set Uygulama = CreateObject("Outlook.Application")
   
    Son = S3.Cells(S3.Rows.Count, 1).End(3).Row
    If Son < 3 Then Son = 3
   
    Veri = S3.Range("A2:C" & Son).Value
  
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 1) <> "" Then
       
            With S2
                .Range("A1:E" & .Rows.Count).AutoFilter Field:=1, Criteria1:=Veri(X, 1)
                .Range("A1").CurrentRegion.Copy
            End With
  
            Workbooks.Add (1)
            ActiveSheet.Paste
            Columns.AutoFit
            Range("A1").Select
           
            Application.DisplayAlerts = False
            Dosya_Adi = ThisWorkbook.Path & Application.PathSeparator & Veri(X, 1) & ".xlsx"
            ActiveWorkbook.SaveAs Dosya_Adi, 51
            ActiveWorkbook.Close
            Application.DisplayAlerts = True
           
            On Error Resume Next
            S2.ShowAllData
            On Error GoTo 0
           
            Set Yeni_Mail = Uygulama.CreateItem(0)
                  
            Mesaj = "Merhaba " & Veri(X, 2) & "," & "<br><br>" & S1.Range("J3").Value & "<br>" & _
                    "<br>" & S1.Range("J5").Value & "<br>" & _
                    "<br>" & S1.Range("J7").Value & "<br>" & _
                    "<br>" & S1.Range("J9").Value & "<br>" & _
                    "<br>" & S1.Range("J11").Value & "<br><br>" & _
                    "İyi çalışmalar."
  
            Mesaj = "<p style='color:black;font-family:Calibri;font-size:13.5'>" & Mesaj & "</font></p>"
  
            With Yeni_Mail
                .Display
                .To = Veri(X, 3)
                .Cc = "pivazovski@hotmail.com"
                .Bcc = ""
                .Subject = S1.Range("J1").Value
                .HTMLBody = Mesaj & .HTMLBody
                .Attachments.Add Dosya_Adi
                .BodyFormat = 2
                .Save
                '.Send
            End With

            Kill Dosya_Adi
        End If
    Next
   
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set Yeni_Mail = Nothing
    Set Uygulama = Nothing
  
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
O

omarpz

Katılım
4 Ocak 2021
Mesajlar
22
Excel Vers. ve Dili
Microsoft Excel 2016 MSO 16.0.4266.1001 Türkçe
Korhan bey,
İsim kısmı çözüldü fakat makroyu çalıştırdığımda run-time error’53’ file not found hatası vermektedir.
Maile eklenen exceli silmede bir problem yaşanıyor sanırım.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst