Makro ile Mail içeriğine Dosya Ekleme

[xnanx]

Merhaba,

Excel de iki tane makrom var, bunları ayrı ayrı butonlara atatım.

1. Buton veriyi PDF e çevirip dosyaya atıyor.
2. Buton da mail gönderim ekranına atıyor,

2. kodun devamına pdf çevirdiği dosyayı attaç edebilir miyim?



Kodlar;

Sub Makro1()
'
' Makro1 Makro
' 'FORM B8 de yazan değer için

'
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & Sheets("FORM").Range("B8").Value & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
    
    

End Sub

Sub Outlook_Mail_Every_Worksheet_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
    Dim OutApp As Object
    Dim OutMail As Object
    Dim ws As Worksheet
 
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
 
    Set OutApp = CreateObject("Outlook.Application")
 
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Range("a7").Value Like "?*@?*.?*" Then
            Set OutMail = OutApp.CreateItem(0)
 
            On Error Resume Next
            With OutMail
                .To = ws.Range("a7").Value
                .CC = ""
                .BCC = ""
                .Subject = "aaaaaaaaaaa" & ws.Range("b8").Value
                .HTMLBody = ""
                          
                          
    
                .Display '.Send
            End With
            On Error GoTo 0
 
            Set OutMail = Nothing
        End If
    Next ws
 
    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
        
    
End Sub

 

[PLİNT]

Merhaba
Her sayfa için ayrı mail gönderiyor sanırım ama eklenecek pdf aynı ise kodlarınızdaki ilgili aralığa aşağıdaki işaretli bölümü ekleyip deneyin

'.....
'....kodlar
'.....'
'....'
.Subject = "aaaaaaaaaaa" & ws.Range("b8").Value
  .HTMLBody = ""

'///////////////////
If Dir(ThisWorkbook.Path & "\" & Sheets("FORM").Range("B8").Value & ".pdf") <> "" Then
.Attachments.Add ThisWorkbook.Path & "\" & Sheets("FORM").Range("B8").Value & ".pdf"
Else
MsgBox "Dosya bulunamadı"
End If
'//////////////////////

   .Display
'.Send
      End With
    '......
    '...diğer kodlar
    '.......
    '....