View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.worksheet.functions
ryguy7272 ryguy7272 is offline
external usenet poster
 
Posts: 2,836
Default 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