Mailing PDF from EXCEL

[gvreddyhr]

Hi,

I have clarification while converting excel as pdf and sending email through outlook, I have tried few ways but the code which given below checks for email address in each sheet and prompt for mail, can anyone correct the below code for converting the data from active worksheet or particular sheet instead looping through the all sheets.

Thanks in advance

[VBA]Sub FormT_Picture9_Click()
Dim sh As Worksheet
Dim TempFilePath As String
Dim TempFileName As String
Dim FileName As String

'Temporary path to save the PDF files
'You can also use another folder like
'TempFilePath = "C:\Users\Ron\MyFolder\"
TempFilePath = Environ$("temp") & "\"

'Loop through every worksheet
For Each sh In ThisWorkbook.Worksheets
FileName = ""

'Test A1 for a mail address
If sh.Range("d2").Value Like "?*@?*.?*" Then

'If there is a mail address in A1 create the file name and the PDF
TempFileName = TempFilePath & "Form T " & ".pdf"

FileName = GVR_Create_PDF(Range("a2:AC23"), TempFileName, True, False)


'If publishing is OK create the mail
If FileName <> "" Then
GVR_Mail_PDF_Outlook FileName, sh.Range("d2").Value, "FORM T", _
"Hi" & " " & vbNewLine & vbNewLine & "Please find the attached Form T for the year " _
& vbNewLine & vbNewLine & vbNewLine & vbNewLine & "GV Reddy", False

'After the mail is created delete the PDF file in TempFilePath
If Dir(TempFileName) <> "" Then Kill TempFileName

Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"The path to Save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exist"
End If

End If
Next sh
End Sub[/VBA]

[slamet Harto]

It need an add-in to convert.
Why wouldn't try this code

[VBA]
'Original code http://www.rondebruin.nl/sendmail.htm

Sub Mail_ActiveSheet_PDF_Outlook()
'Note: It is easy to change the code to send a workbook, selection or range.
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim FilenameStr As String

If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

FilenameStr = Application.DefaultFilePath & "\" & _
Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=FilenameStr, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

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

strbody = "Hi there" & vbNewLine & vbNewLine & _
"See the attached PDF file with the last figures" & vbNewLine & _
vbNewLine & "Regards Ron"

On Error Resume Next
With OutMail
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line1"
.Body = strbody
.Attachments.Add FilenameStr
.Send 'or use .Display
End With
On Error GoTo 0

'Delete the pdf you send
Kill FilenameStr

Set OutMail = Nothing
Set OutApp = Nothing
Else
MsgBox "PDF add-in Not Installed"
End If
End Sub
[/VBA]