Macro Time stamp Help
Very generic, but try the code below (found bits and pieces on this DG a
while back; some code is my own design):
Public Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function ReturnUserName() As String
' returns the NT Domain User Name
Dim rString As String * 255, sLen As Long, tString As String
tString = ""
On Error Resume Next
sLen = GetUserName(rString, 255)
sLen = InStr(1, rString, Chr(0))
If sLen 0 Then
tString = Left(rString, sLen - 1)
Else
tString = rString
End If
On Error GoTo 0
ReturnUserName = LCase(Trim(tString))
End Function
Sub DateTime()
Sheets("Time Stamp").Select
Range("A1").Select
Selection = "=ReturnUserName()"
Range("A2").Select
Selection = "=now()"
Selection.NumberFormat = "h:mm"
Range("A3").Select
Selection = "=today()"
Range("4:4").Select
Selection.EntireRow.Insert
Range("B3:CA3").Select
Selection.Copy
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("A4").Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]<"""",ROW()-3,"""")"
Range("A4").Select
Selection.AutoFill Destination:=Range("A4:A1002")
Range("A4:A1002").Select
Range("A1").Select
End Sub
"DP7" wrote:
Hi I need some help to get my macro working properly. I need it to save a
file with the days date @ the end. I got that part working but I can't get
the time to show up in the file name.When I add the h:mm to the macro it
fails to run. Any help would be welcome. The macro I am using is shown below.
Thanks
ActiveWorkbook.SaveAs Filename:= _
"R:\Production Reports\Production Summary Report\Daily Production
Summary Copies\Production Summary Report Master" & Format(Now,
"mm-dd-yyyy_H:MM") & ".xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.Quit
ThisWorkbook.Close SaveChanges:=True
End Sub
|