Option Compare Database
Option Explicit
Dim accrual As Database
Dim Accts As Recordset, MoveTable As Recordset
Dim MaxDateQry As Recordset
Dim DayCriteria As String, DayQuery As Command, WorkingSet As
Recordset
Dim TableName As String, MoveTableName As String
Dim DayOfWeek As Integer, DayField, strPurpose As String, MoveDate As
Date
Dim intCounter As Integer
'Movement Build variables
Dim Criteria As String, CriteriaCount As Integer
'AddMultiDay variables
Dim strMsg As String, dteCounter As Date, ctlText As Control
Public Function SelectMove()
DayOfWeek = 1
MoveTableName = "Movements"
TableName = "Accounts"
MoveDate = dteCounter
DayOfWeek = WeekDay(MoveDate, 1)
Select Case DayOfWeek
Case 2
DayField = "rMonday"
Case 3
DayField = "rTuesday"
Case 4
DayField = "rWednesday"
Case 5
DayField = "rThursday"
Case 6
DayField = "rFriday"
End Select
Select Case Forms![Movement Build]!cmbPurpose
Case 99
strPurpose = ""
Case Else
strPurpose = " AND [PurposeType] = " & Str$(Forms![Movement
Build]!cmbPurpose)
End Select
DayCriteria = "SELECT * FROM " & TableName & " WHERE " & DayField & "
= YES" & strPurpose
Set WorkingSet = accrual.OpenRecordset(DayCriteria)
Set MoveTable = accrual.OpenRecordset(MoveTableName)
If Not (WorkingSet.EOF) Then
WorkingSet.MoveFirst
Do Until WorkingSet.EOF
For intCounter = 1 To WorkingSet!DailyOccur
AddMovement
Next intCounter
WorkingSet.MoveNext
Loop
WorkingSet.Close
MoveTable.Close
End If
End Function
Public Function Refresh_Movement_Build()
Forms![Movement Build].Requery
Forms![Movement Build].Refresh
End Function
Public Function GetMaxDate()
Dim LastDate As Date, NextDate As Date, LastDay As Integer
Dim ARTally As Database, MaxDateQry As Recordset
'Set accrual = DBEngine.Workspaces(0).OpenDatabase("h:\freight finance
tables.mdb")
Set accrual = DBEngine.Workspaces(0).OpenDatabase("c:\tl
accrual\freight finance tables.mdb")
Set MaxDateQry = accrual.OpenRecordset("MaxDate")
LastDate = MaxDateQry!MaxDate
LastDay = WeekDay(LastDate, 1)
Select Case LastDay
Case 5
NextDate = LastDate + 3
Case Else
NextDate = LastDate + 1
End Select
MaxDateQry.Close
End Function
Public Function AddMovement()
' this function add movements to the table
With WorkingSet
MoveTable.AddNew
MoveTable![AcctCodeKey] = ![AcctCodeKey]
MoveTable![CarrierNmb] = ![CarrierNmb]
MoveTable![Cost] = ![Cost]
MoveTable![MiscCharge] = ![MiscCharge]
MoveTable![FuelCharge] = ![FuelCharge]
MoveTable![MoveDate] = MoveDate
MoveTable![Describe] = ![Dest]
MoveTable.Update
End With
End Function
Public Function AddMultiDay()
' this routine adds multiple days to the movement table
If IsNull(Forms![Movement Build]![StartDate]) Then
strMsg = "Start Date can not be Null !!! Re- Enter"
MsgBox strMsg
Set ctlText = Forms![Movement Build]![StartDate]
ctlText.SetFocus
Exit Function
End If
If IsNull(Forms![Movement Build]![EndDate]) Then
Forms![Movement Build]![EndDate] = Forms![Movement
Build]![StartDate] Set ctlText = Forms![Movement
Build]![StartDate] ctlText.SetFocus
Exit Function
End If
If Forms![Movement Build]![StartDate] > Forms![Movement
Build]![EndDate] Then strMsg = "Start Date can not be Greater
than the End Date!! Check your Dates"
MsgBox strMsg
Set ctlText = Forms![Movement Build]![StartDate]
ctlText.SetFocus
Exit Function
End If
'Set accrual = DBEngine.Workspaces(0).OpenDatabase("h:\freight finance
tables.mdb")
Set accrual =
DBEngine.Workspaces(0).OpenDatabase("p:gautam\tables.mdb")
MoveTableName = "Movements"
TableName = "Accounts"
For dteCounter = Forms![Movement Build]![StartDate] To Forms![Movement
Build]![EndDate]
DayOfWeek = WeekDay(dteCounter, 1)
If DayOfWeek > 1 And DayOfWeek < 7 Then
SelectMove
End If
Next dteCounter
strMsg = "Movements Added !!!"
MsgBox strMsg
End Function
Dirk Goldgar said:
Please post the complete code. The following works fine for me: