Sub SaveAsPdfAndEmail()
Dim fPATH As String, fNAME As String, eADDR As String
Dim OutApp As Object, OutMail As Object
Do
eADDR = Application.InputBox("Enter email address", _
"Email", "[email protected]", Type:=2)
If eADDR = "False" Then Exit Sub
If InStr(eADDR, "@") > 0 And InStr(eADDR, ".") > 0 Then Exit Do
Loop
fPATH = "C:\2013\" 'remember the final \ in this string
With ActiveSheet
fNAME = .[D9] & "-" & .[E9] & "-" & .[G9] & .[G11] & "-" & "-" & Format(.[F9], "DDMMYY") & ".pdf"
.Range("C6:H43").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=fPATH & fNAME, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False 'True is you want to see the PDF
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = eADDR
.CC = ""
.BCC = ""
.Subject = "abc: " & fNAME
.Attachments.Add fPATH & fNAME
.Display 'or use .Send
Sheets("Cleaning Audit").Range("G42").Value = "Yes"
End With
End Sub
I have two issues:
1. I want the file in PDF saved in appropriate Month folder as per the date.
Please refer to RED highlighted text.
Secondly
After all the above actions are completed, I want following cells to be cleared or say made blank.
Sheet3
Cells: G9, D11:E31, F22:F24, D33, G11 and F14:F19
I am not sure How do I modify the code to include this.
Need help please.
Regards
Bookmarks