Letzten Zugriff auf Office Anwendung auswerten

Option Explicit
'Declaration  
Dim FSO, File, Output
'Constants  
Const Filename = "C:\Program Files\Microsoft Office\OFFICE11\Excel.exe"  

'Create Object  
Set FSO = CreateObject("Scripting.FileSystemObject")  

'File exists  
If FSO.FileExists(Filename) Then
	'Yes  
	Set File = FSO.GetFile(Filename)
	MsgBox("Last Access: " & File.DateLastModified)  
Else
	MsgBox("File does not exists")  
End If

'Declaration  
Dim FSO, File, LogText, Logname, f
'Constants  
Const Filename = "C:\Program Files\Microsoft Office\OFFICE11\Excel.exe"  
Main
Sub Main
ComputerName
Access
WriteDown
End Sub

Function ComputerName
Set wshShell = WScript.CreateObject( "WScript.Shell" )  
strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )  
LogText = "Computer Name: " & strComputerName  
End Function

Function Access
'Create Object  
Set FSO = CreateObject("Scripting.FileSystemObject")  

'File exists  
If FSO.FileExists(Filename) Then
	'Yes  
	Set File = FSO.GetFile(Filename)
	LogText = LogText & "; " & Filename & "; Last Access: " & File.DateLastAccessed   
Else
	LogText
End If
End Function

Function WriteDown
	Logname = "c:\temp\Softwareprotocol.log"  
	
	If (fso.FileExists(Logname)) Then
		Set f = fso.OpenTextFile(Logname, 8, True)
		f.WriteLine LogText
		f.Close
	Else
		Set f = fso.CreateTextFile(Logname, True)
		f.WriteLine LogText
		f.Close
	End If
End Function