Emailing converted to PDF Worksheet

[Rab_marr]

Good morning all,

I found a lovely little piece of code that converts a worksheet to a PDF and emails to outlook and works perfectly for me, however the code is unique to my login identifier within the company I work for:

Sub SendSheetAsPDF()


Dim olApp As Object

Path = "C:\Users\xxxxxxxxx\Desktop" ' pls adjust
Salesman = ActiveSheet.Name
strDate = Format(Date, "ddmmyyyy")
If i > 1 Then PDF_File = Left(PDF_File, i - 1)
PDF_File = Path & Salesman & strDate & ".pdf"

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


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


With olApp.CreateItem(0)
.Subject = Format(Date, "yyyymmdd") & "-AinU Report-O"
.To = Range("A1")
.Body = Range("H3") & vbLf & vbLf _
& "Please find your AinU Report attached." & vbLf & vbLf _
& "Regards,"
.Attachments.Add PDF_File
.Display

End With

' if you want to delete it
'Kill PDF_File

Set olApp = Nothing

End Sub

Like I said this works a treat for me where the "xxxxxxxx" within the path is my login name.

Is there a way where "xxxxxxxxx" can be substituted for whoever is logged in at the time?

Many thanks in advance for looking into my problem

Rab

 

[yky]

Path=Environ("USERPROFILE") & "\Desktop"

 

[Rab_marr]

YkY,

Thanks for that, works a treat.

Rab