count your work hours - a free macro

[rami]

here is a short macro. it works on outlook. everytime you run outlook,
it writes the hour in an excel sheet, and the same - when outlook is
closed.
so, in the end of the month you can get your total work hours.
you will have to include a reference to ms excel and sign the macro in
order to run it.
any improvments will be welcomed.
good luck.
rami

thisOutlookSession:
-------------------
Public title As String

Private Sub Application_Quit()
Dim showEnter As frmGui
title = "leaving time:"

Set showEnter = New frmGui
showEnter.Hide
showEnter.lblTitle.Caption = title
showEnter.Repaint
showEnter.Show


End Sub

Private Sub Application_Startup()

Dim showEnter As frmGui
title = "enterence time:"

Set showEnter = New frmGui
showEnter.Hide
showEnter.lblTitle.Caption = title
showEnter.Repaint
showEnter.Show


user form:
----------

Public myDate As Date
Public myTime As String
Public title As String
Dim mon As Integer
Dim enter As Boolean

Private Sub cmdCancel_Click()
Unload Me
Exit Sub
End Sub

Private Sub cmdOk_Click()
myDate = txtDate.Text
myTime = txtTime.Text
If (lblTitle.Caption = "enterence time:") Then enter = True
Call update_file(myTime, myDate, enter)
Unload Me
Exit Sub
End Sub

Private Sub UserForm_Initialize()
myDate = Date
myTime = Time
txtTime.Text = myTime
txtDate = myDate
lblTitle.Caption = title


module:
-------

Public goExcel As Object
Public oWB As Excel.Workbook



Public Sub update_file(myTime As String, myDate As Date, enter As
Boolean)

Dim Myday, x As Integer
Dim Mymonth, myYear, file_Name As String
Dim isEnter As Boolean
isEnter = enter
Myday = day(myDate)
Mymonth = month(myDate)
If month(myDate) < 10 Then Mymonth = "0" & Mymonth
myYear = Year(myDate)
Set goExcel = CreateObject("Excel.Application")
Call create_folder
file_Name = "C:\work\xx" & Mymonth & myYear & "$.xls"
Call create_file(file_Name)
Set oWB = goExcel.Workbooks.Open(file_Name)

goExcel.Application.Visible = False
'goExcel.DisplayAlerts = False
If (isEnter = True) Then
x = 1
Else
x = 2
End If

oWB.Sheets(1).Cells(Myday, x).Value = myTime
'oWB.Sheets("Sheet1").Cells(Myday, x).Value = myTime

oWB.Save
goExcel.Quit
Set oWB = Nothing
Set goExcel = Nothing


End Sub


Public Sub create_folder()
On Error GoTo create_work
Dim fs, isFolder As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Set isFolder = fs.GetFolder("C:\work")
Exit Sub

create_work:
fs.CreateFolder ("C:\work")
Resume

End Sub


Public Sub create_file(file_Name As String)

Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
If (fs.FileExists(file_Name) = False) Then
Set oWB = goExcel.Workbooks.Add
oWB.SaveAs (file_Name)
End If

End Sub