How to send data as an attachment in PDF format.

guptapradeep433

New Member
Joined
Jan 14, 2023
Messages
7
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Hi All, currently this code copy paste the data as a table in the email body, instead how can i send as PDF attachment, 2. how to add my outlook signature?




VBA Code:
Sub mailstrangejosh()
    Dim OutApp As Object, OutMail As Object
    Dim myRng As Range, v As Variant
    Dim j As Long, lastRow As Long
    Dim strbody As String
    Dim outlookmailitem As Object
    Dim edress As String
    
    Application.ScreenUpdating = False

    lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v = Range("A1:X" & lastRow).Value
                    
    Set OutApp = CreateObject("Outlook.Application")
    With CreateObject("scripting.dictionary")
    
        For j = 2 To lastRow
            If Not .exists(v(j, 2)) Then
                .Add v(j, 2), Nothing
                
                strbody = "Hello , " & v(j, 20) & "<br></br>" & vbNewLine & vbNewLine & _
               "<br> Please find the below banker  feedback details. Thank you" & "<br/><br>"
                
                With ActiveSheet
                    .Range("A1").AutoFilter 2, v(j, 2)
                    Set myRng = .Range("A1:I" & lastRow).SpecialCells(xlCellTypeVisible)
                    
                    Set OutMail = OutApp.CreateItem(0)
                    With OutMail
                        .To = v(j, 2)
                        'To = Range("B2")
                        .cc = "person1@email.com;person2@email.com"
                        .Subject = v(j, 10) & "Banker Feedback"
                        .HTMLBody = strbody & RangetoHTML(myRng)
                         .display        'to show
                         '.Send 'to send
                    End With
                End With
            End If
        Next j
      
    End With
    
    Range("A1").AutoFilter
    
    Application.ScreenUpdating = True
End Sub

Function RangetoHTML(myRng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    Dim i      As Integer
    
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    
    myRng.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
        For i = 7 To 12
        
            With .UsedRange.Borders(i)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlMedium
            End With
        Next i
    End With
    
    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
    
    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=")
            
    TempWB.Close savechanges:=False
    
    Kill TempFile
          
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
  
End Function
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Hi guptapradeep433,
try this code, adapt if necessary the name of the pdf file

VBA Code:
Sub mailguptapradeep433()
'https://www.mrexcel.com/board/threads/how-to-send-data-as-an-attachment-in-pdf-format.1226966/
    
Dim OutApp As Object, OutMail As Object
Dim myRng As Range, myHeader As Range, v As Variant
Dim j As Long, lastRow As Long
Dim strbody As String, MyPdf As String
    
Application.ScreenUpdating = False

lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
v = Range("A1:X" & lastRow).Value

Set OutApp = CreateObject("Outlook.Application")
With CreateObject("scripting.dictionary")
    
    For j = 2 To lastRow
        If Not .exists(v(j, 2)) Then
            .Add v(j, 2), Nothing
            
            strbody = "Hello , " & v(j, 20) & "<br></br>" & vbNewLine & vbNewLine & _
                      "<br> Please find the below banker  feedback details. Thank you" & "<br/><br>"
            
            With ActiveSheet
                .Range("A1").AutoFilter 2, v(j, 2)
                
                Set myHeader = .Range("A1:I1")
                Set myRng = .Range("A2:I" & lastRow).SpecialCells(xlCellTypeVisible)
                
                .PageSetup.PrintArea = Range(myHeader, myRng).Address
                .PageSetup.Orientation = xlLandscape
                .PageSetup.FitToPagesWide = 1
                
                MyPdf = Environ$("temp") & "\" & v(j, 10) & ".pdf"        '<<=== PDF name from column J value(10th column)
                
                Range(myHeader, myRng).ExportAsFixedFormat _
                                Type:=xlTypePDF, _
                                Filename:=MyPdf, _
                                Quality:=xlQualityStandard, _
                                IncludeDocProperties:=True, _
                                IgnorePrintAreas:=False, _
                                OpenAfterPublish:=False
                
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .Display        'to show
                    .To = v(j, 2)
                    'To = Range("B2")
                    .cc = "person1@email.com;person2@email.com"
                    .Subject = v(j, 10) & " Banker Feedback"
                    .HTMLBody = strbody & "<br>" & .HTMLBody
                    .Attachments.Add MyPdf
                    '.Send 'to send
                End With
            End With
        End If
        
    Next j
    
End With

Range("A1").AutoFilter

Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi guptapradeep433,
try this code, adapt if necessary the name of the pdf file

VBA Code:
Sub mailguptapradeep433()
'https://www.mrexcel.com/board/threads/how-to-send-data-as-an-attachment-in-pdf-format.1226966/
   
Dim OutApp As Object, OutMail As Object
Dim myRng As Range, myHeader As Range, v As Variant
Dim j As Long, lastRow As Long
Dim strbody As String, MyPdf As String
   
Application.ScreenUpdating = False

lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
v = Range("A1:X" & lastRow).Value

Set OutApp = CreateObject("Outlook.Application")
With CreateObject("scripting.dictionary")
   
    For j = 2 To lastRow
        If Not .exists(v(j, 2)) Then
            .Add v(j, 2), Nothing
           
            strbody = "Hello , " & v(j, 20) & "<br></br>" & vbNewLine & vbNewLine & _
                      "<br> Please find the below banker  feedback details. Thank you" & "<br/><br>"
           
            With ActiveSheet
                .Range("A1").AutoFilter 2, v(j, 2)
               
                Set myHeader = .Range("A1:I1")
                Set myRng = .Range("A2:I" & lastRow).SpecialCells(xlCellTypeVisible)
               
                .PageSetup.PrintArea = Range(myHeader, myRng).Address
                .PageSetup.Orientation = xlLandscape
                .PageSetup.FitToPagesWide = 1
               
                MyPdf = Environ$("temp") & "\" & v(j, 10) & ".pdf"        '<<=== PDF name from column J value(10th column)
               
                Range(myHeader, myRng).ExportAsFixedFormat _
                                Type:=xlTypePDF, _
                                Filename:=MyPdf, _
                                Quality:=xlQualityStandard, _
                                IncludeDocProperties:=True, _
                                IgnorePrintAreas:=False, _
                                OpenAfterPublish:=False
               
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .Display        'to show
                    .To = v(j, 2)
                    'To = Range("B2")
                    .cc = "person1@email.com;person2@email.com"
                    .Subject = v(j, 10) & " Banker Feedback"
                    .HTMLBody = strbody & "<br>" & .HTMLBody
                    .Attachments.Add MyPdf
                    '.Send 'to send
                End With
            End With
        End If
       
    Next j
   
End With

Range("A1").AutoFilter

Application.ScreenUpdating = True
End Sub

1. Thank you so much for the code I am still having issues with the OUTLOOK SIGNATURE. it is not getting added by default after the Body of the text. Could you please recheck or do any extra setting need to be done?

2. How to make outlook Subject and Body text as Calibri font with 11 point.
 
Upvote 0
1. Muito obrigado pelo código. Ainda estou tendo problemas com a ASSINATURA DO OUTLOOK. não está sendo adicionado por padrão após o corpo do texto. Você poderia verificar novamente ou alguma configuração extra precisa ser feita?

2. Como tornar o assunto e o corpo do Outlook como fonte Calibri com 11 pontos.

1. Thank you so much for the code I am still having issues with the OUTLOOK SIGNATURE. it is not getting added by default after the Body of the text. Could you please recheck or do any extra setting need to be done?

2. How to make outlook Subject and Body text as Calibri font with 11 point.
Try this code for Calibri 11 (Subject) :

VBA Code:
strbody = "<BODY style=font-size:11pt;font-family:Calibri>Hello , " & v(j, 20) & "<br></br>" & vbNewLine & vbNewLine & _
              "<br> Please find the below banker  feedback details. Thank you" & "<br/><br>"
 
Upvote 0
Try this code for Calibri 11 (Subject) :

VBA Code:
strbody = "<BODY style=font-size:11pt;font-family:Calibri>Hello , " & v(j, 20) & "<br></br>" & vbNewLine & vbNewLine & _
              "<br> Please find the below banker  feedback details. Thank you" & "<br/><br>"

Thank you so much Flaiban... amazing

Can anyone help me with 2 more thing

1. how to add outlook signature by default after the body text as per the user name who is going to send an email.
2. How to add an extra COUNT row at the end of each individuals data.
 
Upvote 0
Hi all,
many thanks to @guptapradeep433 for the feedback, here is my new attempt, untested:
VBA Code:
Sub mailguptapradeep433S()
'https://www.mrexcel.com/board/threads/how-to-send-data-as-an-attachment-in-pdf-format.1226966/
    
Dim OutApp As Object, OutMail As Object
Dim myRng As Range, myHeader As Range, v As Variant
Dim j As Long, lastRow As Long
Dim strbody As String, MyPdf As String, Signature As String
    
Application.ScreenUpdating = False

lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
v = Range("A1:X" & lastRow).Value

Set OutApp = CreateObject("Outlook.Application")
With CreateObject("scripting.dictionary")
    
    For j = 2 To lastRow
        If Not .exists(v(j, 2)) Then
            .Add v(j, 2), Nothing
            
            strbody = "<BODY style=font-size:11pt;font-family:Calibri>Hello , " & v(j, 20) & "<br></br>" & vbNewLine & vbNewLine & _
              "<br> Please find the below banker  feedback details. Thank you" & "<br/><br>"
            
            With ActiveSheet
                .Range("A1").AutoFilter 2, v(j, 2)
                
                Set myHeader = .Range("A1:I1")
                Set myRng = .Range("A2:I" & lastRow + 1).SpecialCells(xlCellTypeVisible)
                
                .PageSetup.PrintArea = Range(myHeader, myRng).Address
                
                .PageSetup.Orientation = xlLandscape
                .PageSetup.FitToPagesWide = 1
                
                MyPdf = Environ$("temp") & "\" & v(j, 10) & ".pdf"        '<<=== PDF name from column J value(10th column)
                
                Range(myHeader, myRng).ExportAsFixedFormat _
                                Type:=xlTypePDF, _
                                Filename:=MyPdf, _
                                Quality:=xlQualityStandard, _
                                IncludeDocProperties:=True, _
                                IgnorePrintAreas:=False, _
                                OpenAfterPublish:=False
                
                Set OutMail = OutApp.CreateItem(0)
                
                With OutMail
                .display
                DoEvents
                End With
                Signature = OutMail.HTMLBody
                
                With OutMail
                    '.display        'to show
                    .To = v(j, 2)
                    'To = Range("B2")
                    .cc = "person1@email.com;person2@email.com"
                    .Subject = v(j, 10) & " Banker Feedback"
                    .HTMLBody = strbody & "<br>" & Signature
                    .Attachments.Add MyPdf
                    '.Send 'to send
                End With
            End With
        End If
        
    Next j
    
End With

Range("A1").AutoFilter

Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi all,
many thanks to @guptapradeep433 for the feedback, here is my new attempt, untested:
VBA Code:
Sub mailguptapradeep433S()
'https://www.mrexcel.com/board/threads/how-to-send-data-as-an-attachment-in-pdf-format.1226966/
   
Dim OutApp As Object, OutMail As Object
Dim myRng As Range, myHeader As Range, v As Variant
Dim j As Long, lastRow As Long
Dim strbody As String, MyPdf As String, Signature As String
   
Application.ScreenUpdating = False

lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
v = Range("A1:X" & lastRow).Value

Set OutApp = CreateObject("Outlook.Application")
With CreateObject("scripting.dictionary")
   
    For j = 2 To lastRow
        If Not .exists(v(j, 2)) Then
            .Add v(j, 2), Nothing
           
            strbody = "<BODY style=font-size:11pt;font-family:Calibri>Hello , " & v(j, 20) & "<br></br>" & vbNewLine & vbNewLine & _
              "<br> Please find the below banker  feedback details. Thank you" & "<br/><br>"
           
            With ActiveSheet
                .Range("A1").AutoFilter 2, v(j, 2)
               
                Set myHeader = .Range("A1:I1")
                Set myRng = .Range("A2:I" & lastRow + 1).SpecialCells(xlCellTypeVisible)
               
                .PageSetup.PrintArea = Range(myHeader, myRng).Address
               
                .PageSetup.Orientation = xlLandscape
                .PageSetup.FitToPagesWide = 1
               
                MyPdf = Environ$("temp") & "\" & v(j, 10) & ".pdf"        '<<=== PDF name from column J value(10th column)
               
                Range(myHeader, myRng).ExportAsFixedFormat _
                                Type:=xlTypePDF, _
                                Filename:=MyPdf, _
                                Quality:=xlQualityStandard, _
                                IncludeDocProperties:=True, _
                                IgnorePrintAreas:=False, _
                                OpenAfterPublish:=False
               
                Set OutMail = OutApp.CreateItem(0)
               
                With OutMail
                .display
                DoEvents
                End With
                Signature = OutMail.HTMLBody
               
                With OutMail
                    '.display        'to show
                    .To = v(j, 2)
                    'To = Range("B2")
                    .cc = "person1@email.com;person2@email.com"
                    .Subject = v(j, 10) & " Banker Feedback"
                    .HTMLBody = strbody & "<br>" & Signature
                    .Attachments.Add MyPdf
                    '.Send 'to send
                End With
            End With
        End If
       
    Next j
   
End With

Range("A1").AutoFilter

Application.ScreenUpdating = True
End Sub
Hi there, i tried the above code but no luck
 
Upvote 0
Hi, I don't usually use the signature in emails, but I did a test with a fake signature and it works well, as you can see from the attached image
 

Attachments

  • Mail_Signature.png
    Mail_Signature.png
    28.9 KB · Views: 12
Upvote 0
Solution

Forum statistics

Threads
1,223,910
Messages
6,175,320
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top