Makro ile Mail gönderme

M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
Merhaba,

Her aya ait birden fazla tablom bulunmakta. Tüm tabloları tek tek mail gönderiyorum. Her aya ait tüm tabloları tek makro ile hepsini mail göndermek istiyorum.
Burada ki kod çoğaltılabilir mi ?
Sheets("Aylık").Select
Range("$B$7:$R$78").ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False



Tablolar için kullandığım kod :

Kod: 
Sub AylıkUretimRaporuOcak()

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
    
  Title = Range("B7")
  Kime = Range("C2")
  Bilgi = Range("C3")
  Gizli = Range("C4")
  Mesaj = Range("C5")
                    
'  PdfFile = ActiveWorkbook.FullName
'  i = InStrRev(PdfFile, ".")
'  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "" & [B7] & ".pdf"

Sheets("Aylık").Select
Range("$B$7:$R$78").ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

With OutlApp.CreateItem(0)
  
    .Subject = Title
    .To = Kime
    .CC = Bilgi ' bilgi olarak kime
    .BCC = Gizli
    .Body = Mesaj
    '"....," & vbLf & vbLf _
     '     & " ....." & vbLf & vbLf _
      '    & "...." & vbLf _
       '   & [C81] & vbLf _
        '  & [C83] & vbLf & vbLf
    .Attachments.Add PdfFile
  
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail gonderilemedi", vbExclamation, " "
    Else
      MsgBox " E-mail gonderildi... İşleminiz tamamlanmıştır..! ", vbInformation, " "
    End If
    On Error GoTo 0
  
  End With

  Kill PdfFile

  If IsCreated Then OutlApp.Quit

  Set OutlApp = Nothing



End Sub
Yardımlarınız için teşekkür ederim.
 
P

PLİNT

Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Merhaba
Birden fazla sayfayı; tek "pdf" dosyası olarak kaydedip göndermek istiyorsanız;
(Kodlardaki sayfa adlarını düzenlersiniz)
Kod: 
ThisWorkbook.Sheets(Array("Aylık", "Aylık2", "Aylık3")).Select

Sheets("Aylık").Activate
ActiveSheet.Range("$B$7:$R$78").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Aylık").Select
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
PLİNT' Alıntı:
Merhaba
Birden fazla sayfayı; tek "pdf" dosyası olarak kaydedip göndermek istiyorsanız;
(Kodlardaki sayfa adlarını düzenlersiniz)
Kod: 
ThisWorkbook.Sheets(Array("Aylık", "Aylık2", "Aylık3")).Select

Sheets("Aylık").Activate
ActiveSheet.Range("$B$7:$R$78").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Aylık").Select
Genişletmek için tıkla ...
Merhaba Hocam,

Dediğiniz gibi yaptım ancak tek bir raporu gönderiyor.
Kod: 
Sub raporOcak()

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object

  Title = Range("B7")
  Kime = Range("C2")
  Bilgi = Range("C3")
  Gizli = Range("C4")
  Mesaj = Range("C5")
                    
'  PdfFile = ActiveWorkbook.FullName
'  i = InStrRev(PdfFile, ".")
'  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "" & [B7] & ".pdf"

    'ActiveSheet.Range("$B$7:$R$78").ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

ThisWorkbook.Sheets(Array("Aylık", "Üretim Veri Analizi", "Ürün ve Marka Bazında")).Select


Sheets("Aylık").Activate
ActiveSheet.Range("$B$7:$R$78").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Aylık").Select

Sheets("Üretim Veri Analizi").Activate
ActiveSheet.Range("$B$7:$R$99").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Üretim Veri Analizi").Select

Sheets("Ürün ve Marka Bazında").Activate
ActiveSheet.Range("$B$7:$X$78").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Ürün ve Marka Bazında").Select



  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

With OutlApp.CreateItem(0)
  
    .Subject = Title
    .To = Kime
    .CC = Bilgi ' bilgi olarak kime
    .BCC = Gizli
    .Body = Mesaj
    '"....," & vbLf & vbLf _
     '     & " ....." & vbLf & vbLf _
      '    & "...." & vbLf _
       '   & [C81] & vbLf _
        '  & [C83] & vbLf & vbLf
    .Attachments.Add PdfFile
  
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail gonderilemedi", vbExclamation, "MSC"
    Else
      MsgBox " E-mail gonderildi... İşleminiz tamamlanmıştır..! ", vbInformation, "MSC"
    End If
    On Error GoTo 0
  
  End With

  Kill PdfFile

  If IsCreated Then OutlApp.Quit

  Set OutlApp = Nothing


    
      MsgBox " Dosya Kaydedildi... İşleminiz tamamlanmıştır..! ", vbInformation, "MSC"



End Sub
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
Plint Hocam,

Şu şekilde yaptım, oldu ancak PDF dosya adına her tablonun kendi adını almasını yapamadım.


Örnek Aylık sayfasında B7 hücrede bulunan tablo ismini PDF dosya adı olarak yapamadım.


Sheets("Aylık").Activate
PdfFile = PdfFile & "" & [B7] & ".pdf"
ActiveSheet.Range("$B$7:$R$78").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Aylık").Select





Tek makroda şu şekilde yaptım.

Kod: 
Sub raporOcak()

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object

  Title = Range("B7")
  Kime = Range("C2")
  Bilgi = Range("C3")
  Gizli = Range("C4")
  Mesaj = Range("C5")


ThisWorkbook.Sheets(Array("Aylık", "Üretim Veri Analizi", "Ürün ve Marka Bazında")).Select
                    

Sheets("Aylık").Activate
PdfFile = PdfFile & "" & [B7] & ".pdf"
ActiveSheet.Range("$B$7:$R$78").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Aylık").Select

On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

With OutlApp.CreateItem(0)
  
    .Subject = Title
    .To = Kime
    .CC = Bilgi ' bilgi olarak kime
    .BCC = Gizli
    .Body = Mesaj
    '"....," & vbLf & vbLf _
     '     & " ....." & vbLf & vbLf _
      '    & "...." & vbLf _
       '   & [C81] & vbLf _
        '  & [C83] & vbLf & vbLf
    .Attachments.Add PdfFile
  
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail gonderilemedi", vbExclamation, "MSC"
    Else
      MsgBox " E-mail gonderildi... İşleminiz tamamlanmıştır..! ", vbInformation, "MSC"
    End If
    On Error GoTo 0
  
  End With



Sheets("Üretim Veri Analizi").Select
PdfFile = PdfFile & "" & [B7] & ".pdf"
Sheets("Üretim Veri Analizi").Activate
ActiveSheet.Range("$B$7:$R$99").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Üretim Veri Analizi").Select


On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

With OutlApp.CreateItem(0)
  
    .Subject = Title
    .To = Kime
    .CC = Bilgi ' bilgi olarak kime
    .BCC = Gizli
    .Body = Mesaj
    '"....," & vbLf & vbLf _
     '     & " ....." & vbLf & vbLf _
      '    & "...." & vbLf _
       '   & [C81] & vbLf _
        '  & [C83] & vbLf & vbLf
    .Attachments.Add PdfFile
  
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail gonderilemedi", vbExclamation, "MSC"
    Else
      MsgBox " E-mail gonderildi... İşleminiz tamamlanmıştır..! ", vbInformation, "MSC"
    End If
    On Error GoTo 0
  
  End With


Sheets("Ürün ve Marka Bazında").Select
PdfFile = PdfFile & "" & [B7] & ".pdf"
Sheets("Ürün ve Marka Bazında").Activate
ActiveSheet.Range("$B$7:$X$78").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Ürün ve Marka Bazında").Select



  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

With OutlApp.CreateItem(0)
  
    .Subject = Title
    .To = Kime
    .CC = Bilgi ' bilgi olarak kime
    .BCC = Gizli
    .Body = Mesaj
    '"....," & vbLf & vbLf _
     '     & " ....." & vbLf & vbLf _
      '    & "...." & vbLf _
       '   & [C81] & vbLf _
        '  & [C83] & vbLf & vbLf
    .Attachments.Add PdfFile
  
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail gonderilemedi", vbExclamation, "MSC"
    Else
      MsgBox " E-mail gonderildi... İşleminiz tamamlanmıştır..! ", vbInformation, " "
    End If
    On Error GoTo 0
  
  End With

  Kill PdfFile

  If IsCreated Then OutlApp.Quit

  Set OutlApp = Nothing


    
      MsgBox " Dosya Kaydedildi... İşleminiz tamamlanmıştır..! ", vbInformation, " "



End Sub
 
P

PLİNT

Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Merhaba
Siz üç sayfayı tek pdf dosyası yapıp adlandırmak istiyorsunuz değilmi?
PdfFile = sheets("aylık").[b7]
veya
PdfFile = sheets("aylık").[b7] & " " & sheets("Üretim Veri Analizi").[B7] & " " & sheets("Ürün ve Marka Bazında").[b7]
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
Hocam,

3 tablo ayrı ayrı isimlerde, her tabloyu kendi ismi ile pdf yapmak ve olabiliyorsa tek bir mailde göndermek istiyorum. Bu şekilde her tabloyu ayrı ayrı mail atıyor.

Yardımlarınız için teşekkür ederim.
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
Hocam,

Her ay göndermem gereken 7 ayrı tablo var ve bunları her defasında ayrı ayrı pdf yapıp mail gönderiyorum.

Dediğiniz gibi 7 sayfayı tek pdf dosyası yapmak daha mantıklı olur. Tek dosyada nasıl toplarım.

Ocak butonu için PdfFile = PdfFile & "" & [B7] & ".pdf" Ocak 2019 Raporlar
Şubat butonu için ise PdfFile = PdfFile & "" & [B8] & ".pdf" ise Şubat 2019 Raporlar diye yazarım
tüm aylar için bu şekilde buton eklerim.

Teşekkür ederim.
 
P

PLİNT

Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
[B7] hücresi yerine genel bir şey yazılabilir "Ocak 2019 Raporlar " ve yine pdf adı aynı olabilir ama pdf içinde sayfa adları sorun
onun içinde bir örnek yapayım

Ek dosyada ise

3 sayfayı ayrı ayrı 3 pdf yapıp
tek maille ekleyip gönderir
http://dosya.co/1drdxlqya85k/pdf.zip.html
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
PLİNT' Alıntı:
[B7] hücresi yerine genel bir şey yazılabilir "Ocak 2019 Raporlar " ve yine pdf adı aynı olabilir ama pdf içinde sayfa adları sorun
onun içinde bir örnek yapayım

Ek dosyada ise

3 sayfayı ayrı ayrı 3 pdf yapıp
tek maille ekleyip gönderir
http://dosya.co/1drdxlqya85k/pdf.zip.html
Genişletmek için tıkla ...
Teşekkür ederim Hocam,

Bu şekilde gönderdi ancak her tablonun hücreleri farklı

Aylık tabloda ocak ("$B$7:$R$78"), Şubat ise ("$T$7:$AJ$78")

Ürün ve marka bazında ocak ("$B$7:$X$78"), şubat ise ("$B$82:$X$153")

diğer tüm yedi tabloda aynı şekilde ama birbirinden farklı. Yaptığınız çalışmaya bu kısıtı nasıl verebilirim.

sayfalar = Array("Aylık", "Üretim Veri Analizi", "Ürün ve Marka Bazında")
yol = ThisWorkbook.Path
For m = 0 To UBound(sayfalar)
pdff = Sheets(sayfalar(m)).Name & ".pdf"
Sheets(sayfalar(m)).Range("$B$7:$R$78").ExportAsFixedFormat Type:=xlTypePDF,

Tablo hücrelerini nasıl tayin edebilirim.

Teşekkür ederim.
 
P

PLİNT

Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
8. mesajdaki ekli dosyadaki gibi oluyorsa
sayfalar = Array("Aylık", "Üretim Veri Analizi", "Ürün ve Marka Bazında")
hcrler = Array("$B$7:$R$78", "$T$7:$AJ$78", "$B$7:$R$78")
yol = ThisWorkbook.Path
For m = 0 To UBound(sayfalar)
pdff = Sheets(sayfalar(m)).Name & ".pdf"
Sheets(sayfalar(m)).Range(hcrler(m)).ExportAsFixedFormat Type:=xlTypePDF,
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
Hocam,
Eklediğiniz her iki dosya da oldu.
sayfalar = Array("Aylık", "Üretim Veri Analizi", "Ürün ve Marka Bazında")
hcrler = Array("$B$7:$R$78", "$T$7:$AJ$78", "$B$230:$X$300") burada tabloları çoğaltmak için hücreleri belirlemek için sıralamayı takip etmek mi gerek?
Eklediğiniz iki dosyadan hangisini kullanmamı önerirsiniz.

Emeğiniz ve yardımlarınız için teşekkür ederim.
 
P

PLİNT

Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
sayfalar listesindeki ilk sayfa adının alınacak hücre aralığı; hcrler listesinde ilk olmalı öyle takip etmeli
Hangi dosyayı kullanırsanız artık onu siz bilirsiniz
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
Hocam,

Son olarak bi değişiklik yapmak istiyorum pdf isimlerini sayfalardan değilde hücrelerden alabilir mi

pdff = Sheets(sayfalar(m)).Name & ".pdf"
 
P

PLİNT

Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Ayrı dosya oluşturan kodlar için
pdff = Sheets(sayfalar(m)).range("C7") & ".pdf"

sayfaları tek dosya yapan için
pdff = Sheets("Aylık").range("C7") & ".pdf"
 
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
Bu şekilde yaptım
pdff = Sheets("Aylık").Range("B7") & ".pdf" & Sheets("Üretim Veri Analizi").Range("B7") & ".pdf" & Sheets("Ürün ve Marka Bazında").Range("B230") & ".pdf"

ancak burada hata veriyor

Kill ThisWorkbook.Path & "\" & Split(PdfFile, ";")(t)


yani yapmak istediğim her tablonun ilk hücresi pdf dosya adı olsun
(Aylık $B$7), (Üretim Veri Analizi $T$7) ve (Ürün ve Marka Bazında $B$230) gibi
diğer tüm 7 tablo içinde böyle yapmak istiyorum
 
P

PLİNT

Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Merhaba
Aşağıdaki gibi olabilir
'...Mail gönderen bölümdede değişiklik yaparsınız
Kod: 
'....'
'.....kodlarınız'
'....'
sayfalar = Array("Aylık", "Üretim Veri Analizi", "Ürün ve Marka Bazında")
hcrler = Array("B7", "B7", "B230")
yol = ThisWorkbook.Path
For m = 0 To UBound(sayfalar)
Pdff = Sheets(sayfalar(m)).Name & ".pdf"
Sheets(sayfalar(m)).Range(hcrler(m)).ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=yol & "\" & Pdff, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Pdff2 = Pdff2 & Pdff  '__________________
Next
'...
'...Mail gönderen BÖLÜMDEDE DEĞİŞİKLİK YAPIN
'.............
For t = 0 To UBound(Split(Pdff2, ".pdf")) - 1
Kill ThisWorkbook.Path & "\" & Split(Pdff2, ".pdf")(t) & ".pdf"
Next
'......
'diğer kodlarınız
'.......'
'.....
End sub'
 
Son düzenleme:
M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
Hocam,
Emeğiniz ve yardımlarınız için teşekkür ederim. 17. mesajdaki kodları denedim mail gönderiyor ama hiç bir dosya eklemedi.
 
P

PLİNT

Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Dosyaları silen bölüm gibi,dosyaları mail e ekleyen satırları da değişmeliydiniz
Kod: 
'...
'...
   For t = 0 To UBound(Split(Pdff2, ".pdf")) - 1
.Attachments.Add ThisWorkbook.Path & "\" & Split(Pdff2, ".pdf")(t) & ".pdf"
Next
'...
'....
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst