VBA Datum und Uhrzeit

Ich möchte in diesem VBA Code Datum und Uhrzeit einfügen.

#If Win64 Then
Private Declare PtrSafe Function apiCreateFullPath Lib "imagehlp.dll" Alias _
"MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long
#Else
Private Declare Function apiCreateFullPath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" _
(ByVal lpPath As String) As Long
#End If

Sub Save_And_Mail()
Dim sPath$, DateiName$
Dim MyOutApp As Object, MyMessage As Object

sPath = Tabelle1.Range("A12").Value
If Right$(sPath, 1) > "\" Then sPath = sPath & "\"
If Left$(sPath, 1) > "\" Then sPath = "\" & sPath

sPath = "\\tq-fs-01\TQ-Daten$\TQ-Quality-Management\QM\Fehlertracking\Fehlererfassung" & sPath

If apiCreateFullPath(sPath) > 1 Then
MsgBox sPath & vbCr & vbCr & "Order konnte nicht erstellt werden!"
Exit Sub
End If

With ThisWorkbook

DateiName = "neue Fehlermeldung" & ".pdf"
DateiName = "Neue Fehlermeldung" & Mid(.Name, InStrRev(.Name, "."), Len(.Name))
sPath = sPath & DateiName
End With

If Dir(sPath, vbNormal) > "" Then
If MsgBox(DateiName & vbCr & "Datei bereits vorhanden!" & vbCr & _
"Soll eine kobie erstellt werden?", vbQuestion) = vbYes Then

ThisWorkbook.SaveCopyAs sPath
Else
Exit Sub
End If
Else
ThisWorkbook.SaveCopyAs sPath
End If

If Dir(sPath, vbNormal) = "" Then
MsgBox DateiName & vbCr & vbCr & "Datei konnte nicht erstellt werden!"
Exit Sub
End If


Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = "Failure@torqeedo.com"
.Subject = "Fehlermeldung" & Date
.body = "anbei eine neue Fehlermeldung"
.Attachments.Add sPath
.Display
End With

Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub