Automatic Holiday Form

Question

I have a sheet set up for my staff to request holiday and a macro that will convert it to a word doc and email to whomever i require (see below). The preson recieveing the email will look in the holiday book(another workbook) and determine if the holiday can bae accepted/rejected/

I would like to take this one step further and have the macro do the following...

Workbook has 13 sheets > Jan-Dec and a total.

Each sheet has 24 rows and enough columns for days in the month> team 1 (10 members) and a total. team 2 (10 members) and a total. the next line on each calculates the percentage of people in the team off. Each day is 7.5 hours

eg.

A1            A2            A3            A4

               1ST          2ND          3RD

STAFF 1   7.5                           7.5 

STAFF 2                     7.5

STAFF 3                                     7.5

TOTAL      7.5              7.5

Percent   33.33         33.33      66.66         [(7.5/22.5)*100]

so i want the macro to first lookup the person on the total sheet and ensure the required holiday amount is available. if not reject the request as "not enough holiday"

if they have enough holiday see below

lookup the percentage of holiday used and if it is less than 75% send the form as a rejection. If it is above 75% send the form as approved then lookup the persons name depending on date (eg Holiday book 2012/January/1st - add the 7.5 holiday save and close the holiday book.

the only snag is that holiday is requested as a range so 01/04/12-01/04/12 = 1 day (7.5 hrs)...01/04/12-04/04/12 = (5days 37.5hrs)

Im asking a lot here but can it be done?

Sub LotusMail()
     
    
    Dim Maildb As Object
    Dim UserName As String
    Dim MailDbName As String
    Dim MailDoc As Object
    Dim attachME As Object
    Dim Session As Object
    Dim EmbedObj1 As Object
    Dim recipient As String
    Dim ccRecipient As String
    Dim bccRecipient As String
    Dim subject As String
    Dim bodytext As String
    Dim Attachment1 As String
        Dim Body As Object
        Dim recip()
        
        
     
      Application.ScreenUpdating = False
   Set wdApp = New Word.Application
  Set wdDoc = wdApp.Documents.Add
  
   
          Range("N4").Select
    Selection.Copy
    Range("C3:G3").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
  
    ActiveSheet.Range("a1:G26").Copy 
      wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
      Application.CutCopyMode = False
      
          Range("N3").Select
    Selection.Copy
    Range("C3:G3,C5:G5,B7:B8,D7:D8,G7:G8,E16:F16").Select
    Range("E16").Activate
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
       
    Range("I14").Select
    
   Range("c3:g3").Select
   Application.CutCopyMode = False
   
   
         
       
      
 
    
  With wdApp.ActiveWindow
  
        
      If .View.SplitSpecial = wdPaneNone Then
          .ActivePane.View.Type = wdPrintView
      Else
          .View.Type = wdPrintView
      End If
  End With
  
  With wdApp.ActiveDocument.PageSetup
        .TopMargin = CentimetersToPoints(2)
        .BottomMargin = CentimetersToPoints(1.5)
        .LeftMargin = CentimetersToPoints(2.6)
        .RightMargin = CentimetersToPoints(1)
        .HeaderDistance = CentimetersToPoints(0)
        .FooterDistance = CentimetersToPoints(0)
        
        End With
  
  
  
  With wdDoc
  If Dir("C:\Temp\Holiday Request OOH.doc") <> "" Then
            Kill "C:\Temp\Holiday Request OOH.doc"
        End If
        .SaveAs ("C:\Temp\Holiday Request OOH.doc")
         .Close 
    End With
    
    With wdApp
    .Quit
    End With
    
    MsgBox "Your holiday request has been sent to the management Team for Approval"
     
     ReDim Preserve recip(0)
        recip(0) = "test"
        ReDim Preserve recip(1)
        recip(1) = "test"
        'ReDim Preserve recip(2)
        'recip(2) = "OOH TM"
        ccRecipient = Application.UserName
    
    subject = "Holiday Request Form OOH"
    bodytext = "Please find Attached my Holiday Request Form"
     
     
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    Set Maildb = Session.GETDATABASE("", MailDbName)
     
    If Maildb.IsOpen <> True Then
        On Error Resume Next
        Maildb.OPENMAIL
    End If
     
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
     
    
    With MailDoc
        .sendto = recip
        .copyto = ccRecipient
        '.blindcopyto = bccRecipient
        .subject = subject
        .Body = bodytext
    End With
     
     ' saving message
    MailDoc.SAVEMESSAGEONSEND = True
     
    Attachment1 = ("C:\Temp\Holiday Request OOH.doc")
    If Attachment1 <> "" Then
        Set attachME = MailDoc.CREATERICHTEXTITEM("Attachment1")
        Set EmbedObj1 = attachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
     
    
    MailDoc.PostedDate = Now()
    
        
    MailDoc.send 0, recipient
     
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set attachME = Nothing
    Set Session = Nothing
    Set EmbedObj1 = Nothing
     
       
     ActiveWorkbook.Saved = True
ActiveWorkbook.Close
 
End Sub

Answer 1

Hello dude_sweet7,

Your problem is not clear to me. Do you want to calculate the days between two datetime? If so, you can use DateDiff function:

http://www.techonthenet.com/excel/formulas/datediff.php

Best Wishes,

---

Wish a bright future!