Signature Time Stamp in Excel cells

[babar2019]

Hi All,

I have the code below which converts the activesheet and the sheet called 'total' into pdf.

I would like to capture the current username who is logged in and convert that to their full name and capture the date/time stamp that the macro was run while converting to pdf and insert into two different cells of the active sheet.

Example: If I'm logged in and my computer name is jsmith, I want the code to insert "John Smith" into A1 cell and date/timestamp in A2 cell of the active sheet and convert it to pdf. I don't want the macro to insert any name & date/timestamp in the 'total' sheet.

Sub SaveasPDF()

Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet

Sheets(Array("total", wsA.Name)).Select

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & ""

strName = "WORK AS OF" & " " & Format(Date, "MM-DD-YYYY")

'create default name for saving file
strFile = strName & ".pdf"
strPathFile = strPath & strFile

'Create DAily folder under Today's dte
MkDir ("P:\INFORMATION TECHNOLOGY\Non-Public\Applications" & Format(Date, "MM-DD-YYYY"))

'export to PDF in current folder
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& strPathFile

exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub

Thank you

 

[Trevor_S]

Unless there's some lookup table in the workbook that gives the full name for every username, you'll need to use one of the two usernames accessible to the macro. Environ("Username") returns the windows login username. Application.Username returns whatever was used when office was set up.

You'll need to insert one of the sections of code below (depending on which user name you want) after the second "Set.." line of your existing macro:

wbA.wsA.Range("A1").Value = Environ("Username")
wbA.wsA.Range("A2").Value = Format(Now,"dd/mm/yyyy hh:mm:ss")

or:

wbA.wsA.Range("A1").Value = Application.Username
wbA.wsA.Range("A2").Value = Format(Now,"dd/mm/yyyy hh:mm:ss")

You can change the date/time format in the last part of the second line of each.

 

[babar2019]

When I did that, It says cannot create pdf file.

see below:

Sub SaveasPDF()


Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
On Error GoTo errHandler


Set wbA = ActiveWorkbook
Set wsA = ActiveSheet


wbA.wsA.Range("B54").Value = ("Test")
wbA.wsA.Range("I54").Value = Format(Now, "dd/mm/yyyy hh:mm:ss")


Sheets(Array("total", wsA.Name)).Select


'create default name for saving file
strName = "WORK AS OF" & " " & Format(Date, "MM-DD-YYYY") & ".pdf"

'Create DAily folder under Today's dte
strPath = "P:\INFORMATION TECHNOLOGY\Non-Public\Applications" & Format(Date, "MM-DD-YYYY")
If Dir(strPath, vbDirectory) = "" Then MkDir (strPath)
strPathFile = strPath & "" & strName


'export to PDF in current folder
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& strPathFile


exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub

 

[Trevor_S]

The "Could not create pdf file" message simply means that something has triggered the error handler. Can you tell from the spreadsheet whether it did either of the tasks (put Test in B54 or the date/time stamp in I54) - this would help indicate at which point it failed.

You don't need the brackets around "Test". Also, given that you've only just assigned the workbook/sheet, you can probably remove the wbA.wsA. from the start of each line. I don't think that these should be the cause of the problem, but they're worth a try.

Are these two cells, or the sheet more generally, protected? If they are, you will need to get the macro to unprotect it first.

 

[babar2019]

Removing wbA.wsA worked.

Is there an if statement that I can use for example, If environ("Username") is jsmith, insert Johnsmith, If environ("username") is jdoe, insert Johndoe and so on.

because there are only 5 users and I would like to use the environ formula and just hard code their name in the macro itself. Just don't know how to.

 

[Trevor_S]

Replace the line:

Range("B54").Value = ("Test")

with:

Select Case Environ("Username")
  Case "jsmith"
    FullUserName = "Johnsmith"
  Case "jdoe"
    FullUserName = "Johndoe"
  Case Else
    FullUserName = Environ("Username")
End Select
Range("B54").Value = FullUserName

There is a pair of lines for each username - you can add as many pairs as you need between the Select Case... and the Case Else lines. The Case Else bit is to prevent an error if there is a new user who hasn't been hard coded in.

​

 

[babar2019]

This worked, Thanks.

Few more things:

1. How can I create the folder in the same location that the excel was opened from and save the pdf in that folder? Right now I have the path hard coded as "P:\INFORMATION TECHNOLOGY\Non-Public\Applications" in my code.

2. The name of the pdf right now is "WORK AS OF MM-DD-YYYY" How can I save it as 1st 10 characters of the opened excel file name and MM-DD-YYYY.
Example, if the excel file name is RECON 1217.xlsx, I want the pdf to save as RECON 1217 07-01-2019.

Thank you in advance.

 

[Trevor_S]

1. You've already defined wbA as being the active workbook, so its path is wbA.Path

2. Change this line:
strName = "WORK AS OF" & " " & Format(Date, "MM-DD-YYYY") & ".pdf"
to:
strName = Left(wbA.Name,10) & " " & Format(Date, "MM-DD-YYYY") & ".pdf"

Also, if you're using US date formats (month followed by day), you'll probably want to amend the line that I sent you for the date stamp to:
Range("I54").Value = Format(Now, "mm/dd/yyyy hh:mm:ss")

Finally, I've just spotted why the macro that I sent which included wsA didn't work. The setup line just said it was the active sheet, it didn't specify which workbook it was the active sheet on! So line:
Set wsA = ActiveSheet
should be amended to:
Set wsA = wbA.ActiveSheet

 

[babar2019]

Thank you.

In point 1, what I wanted to ask was this excel can live on multiple locations, when users run the macro, I want it to create the date folder from wherever the excel was launched and save the pdf in that folder. Right now if you look at the code, I have it hard coded as P:INFORMATION TECHNOLOGY\Applications\.

If I run the macro from a different location, it still creates the daily folder under P:INFORMATION TECHNOLOGY\Applications\. I want it to create wherever I launch the excel from.

 

[Trevor_S]

Exactly. In the line: Set wbA = ActiveWorkbook you are defining wbA is being the active spreadsheet. Therefore the coding wbA.Path would return the path of the active workbook, wherever it was launched from.

So instead of:
strPath = "P:\INFORMATION TECHNOLOGY\Non-Public\Applications" & Format(Date, "MM-DD-YYYY")
try:
strPath = wbA.Path & Format(Date, "MM-DD-YYYY")