bus_time.bas

adsl拨号工具 有很多功能 不错啊 大家试试

Attribute VB_Name = "Module1"
Option Explicit
Public Function Time_Span(BegDate As Variant, EndDate As Variant) As Variant
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'This function calculates the number of minutes, hours, and days between
'a start date and end date passed to the function.
'The function counts only business days no weekends.
'This function is based upon a 12 hour Business day 7:00 AM to 7:00 PM
'This function does not account for holidays
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
On Error Resume Next
Dim Minutes As Variant
Dim Hours As Variant
Dim Days As Variant
Dim lHolidayCount As Integer
Dim WholeStartDate As Variant
Dim WholeHourStartDate As Variant
Dim WholeEndDate As Variant
Dim WholeHourEndDate As Variant
Dim DayCount As Long
Dim LeftMin As Integer
Dim RightMin As Integer
Dim LeftHours As Integer
Dim RightHours As Integer
Dim IntHour As Integer
Dim intTemp As Integer
Dim i As Integer
      
      BegDate = Format(BegDate, "MM/dd/yyyy HH:mm:ss")
      EndDate = Format(EndDate, "MM/dd/yyyy HH:mm:ss")
      
      WholeStartDate = DateSerial(Year(BegDate), Month(BegDate), Day(BegDate) + 1)
      WholeEndDate = DateSerial(Year(EndDate), Month(EndDate), Day(EndDate))
      WholeHourStartDate = TimeSerial(Format(BegDate, "HH") + 1, 0, 0)
      WholeHourEndDate = TimeSerial(Format(EndDate, "HH"), 0, 0)
   
   If BegDate > EndDate Then  'if start date is after end date
      DayCount = 0
      LeftHours = 0
      LeftMin = 0
      RightHours = 0
      RightMin = 0
      
   ElseIf WholeStartDate > WholeEndDate Then 'if start & end date are the same day
      DayCount = 0
   
         
         If WholeHourStartDate > WholeHourEndDate Then   'start & stop hour are the same
            LeftMin = Format(EndDate, "n") - Format(BegDate, "n")
            LeftHours = 0
            RightMin = 0
            RightHours = 0
         
         ElseIf WholeHourStartDate = WholeHourEndDate Then   'start & stop hour 1 apart
            IntHour = Format(BegDate, "HH")
            intTemp = Format(WholeHourEndDate, "HH")
            
            LeftHours = 0
            RightHours = 0
            
            If IntHour > 7 And IntHour <= 19 Then
               LeftMin = 60 - Format(BegDate, "n")
            Else
               LeftMin = 0
            End If
            
            If intTemp >= 7 And intTemp < 19 Then
               RightMin = Format(EndDate, "n")
            Else
               RightMin = 0
            End If
         
         Else
            IntHour = Format(BegDate, "HH")
            intTemp = Format(WholeHourEndDate, "HH")
            
            If IntHour >= 7 And IntHour <= 19 Then
               LeftMin = 60 - Format(BegDate, "n")
            Else
               LeftMin = 0
            End If
         
            If intTemp >= 7 And intTemp <= 19 Then
               RightMin = Format(EndDate, "n")
            Else
               RightMin = 0
            End If
            
            IntHour = Format(WholeHourStartDate, "HH")
            If IntHour < 7 Then IntHour = 7
            If intTemp > 19 Then intTemp = 19
            
            LeftHours = intTemp - IntHour
            RightHours = 0
                     
         End If
   
   Else
      
      DayCount = WDateDiff(WholeStartDate, WholeEndDate)
           
      DayCount = DayCount - lHolidayCount
      
         IntHour = Format(BegDate, "HH")
         If IntHour > 7 And IntHour <= 19 Then
            LeftMin = 60 - Format(BegDate, "n")
         Else
            LeftMin = 0
         End If
         
         IntHour = Format(WholeHourStartDate, "HH")
         If IntHour <= 7 Then
            LeftHours = 12
            LeftMin = 0
         ElseIf IntHour > 19 Then
            LeftHours = 0
            LeftMin = 0
         Else
            LeftHours = 19 - IntHour
         End If
           
         intTemp = Format(WholeHourEndDate, "HH")
         If intTemp >= 7 And intTemp < 19 Then
            RightMin = Format(EndDate, "n")
         Else
            RightMin = 0
         End If
         
         IntHour = 7
         If intTemp > 19 Then
            RightHours = 12
            RightMin = 0
         Else
            RightHours = intTemp - IntHour
         End If
   End If
        
      Minutes = LeftMin + RightMin
            
      While Minutes >= 60
         Minutes = Minutes - 60
         LeftHours = LeftHours + 1
      Wend
            
      Days = DayCount
      Hours = LeftHours + RightHours
      While Hours >= 12
         Days = Days + 1
         Hours = Hours - 12
      Wend
      
   'Time_Span = Days & " 天" & " "
   Time_Span = Time_Span & Right$("00" & Hours, 2)
   Time_Span = Time_Span & "小时"
   Time_Span = Time_Span & Right$("00" & Minutes, 2)
   Time_Span = Time_Span & "分"
'   Time_Span = Time_Span & Format(Val(Right(EndDate, 2)) - Val(Right(BegDate, 2)), "00") & "秒"
'   Time_Span = Time_Span & Right$("00" & Minutes, 2)
      
End Function


Public Function WDateDiff(BegDate As Variant, EndDate As Variant) As Long
   ' Note that this function does not account for holidays.
   Dim WholeWeeks As Variant
   Dim DateCnt As Variant
   Dim EndDays As Integer
   Dim BegDays As Integer
 
   If IsNull(BegDate) Or IsNull(EndDate) Then
      WDateDiff = 0
      Exit Function
   End If
   
   BegDate = DateValue(BegDate)
   EndDate = DateValue(EndDate)
   DateCnt = BegDate
   BegDays = 0
   
   Do While DateCnt < EndDate
      If Format(DateCnt, "ddd") <> "Sun" Then   'find the first Sunday
         If Format(DateCnt, "ddd") <> "Sat" Then
            BegDays = BegDays + 1
         End If
         DateCnt = DateAdd("d", 1, DateCnt)
      Else
         Exit Do
      End If
   Loop
   
   WholeWeeks = DateDiff("w", DateCnt, EndDate)
   DateCnt = DateAdd("ww", WholeWeeks, DateCnt)
   EndDays = 0
   Do While DateCnt < EndDate
      If Format(DateCnt, "ddd") <> "Sun" And Format(DateCnt, "ddd") <> "Sat" Then
         EndDays = EndDays + 1
      End If
      DateCnt = DateAdd("d", 1, DateCnt)
   Loop
   WDateDiff = WholeWeeks * 5 + BegDays + EndDays

End Function