我在调试此程序时遇到问题，其中byref参数类型不匹配总是出现在此模块中。从Initialize，S2_GetTaskIDs，s2_GetAllTasks部分可以正常但是当它移动到s2_Sort时会出现问题。变量dCnt，tCnt，sCnt，wCnt都是整数。
'for checking of worker on upper level
Dim dicDay As New Dictionary
Dim dicShift As New Dictionary
Public Sub S2_CreateReport()
Initialize '[open connection to oracle]
S2_GetTaskIDs 'get the distinct task ids
S2_GetAllTasks '[get the bulk of tasks for the project, between the days, transfer to s2]
S2_Sort 'sort the Datarecord
CloseAll '[close connection to oracle]
S2_ComputeMode
S2_PlanReport
S2_PrintReport
S2_ForecastReport
End Sub
Private Sub S2_GetTaskIDs()
Dim rstTask As ADODB.Recordset
strQuery = "SELECT DISTINCT TASK_ID, DESCRIPTION FROM PROD_DB WHERE PROJECT_ID = '" & inpProject & "' ORDER BY TASK_ID"
Set rstTask = AdoConn.Execute(strQuery)
tCnt = 0
ReDim TaskID(tCnt)
rstTask.MoveFirst
Do While Not rstTask.EOF
tCnt = tCnt + 1
ReDim Preserve TaskID(tCnt)
TaskID(tCnt).TaskID = rstTask.Fields("TASK_ID").Value
TaskID(tCnt).TaskName = rstTask.Fields("DESCRIPTION").Value
rstTask.MoveNext
Loop
Set rstTask = Nothing
End Sub
Private Sub S2_GetAllTasks()
'Dim pQ As String
Dim rstTask As ADODB.Recordset
strQuery = "SELECT * FROM PROD_DB WHERE"
'get pcodes
'For pCnt = 1 To UBound(PCode())
' If pQ = "" Then
' pQ = " (PROJECT_ID LIKE '" & PCode(pCnt) & "%'"
' Else
' pQ = pQ & " OR PROJECT_ID LIKE '" & PCode(pCnt) & "%'"
' End If
'Next pCnt
'pQ = pQ & ")"
'select * from element_history where (eprocstart>= to_timestamp('Aug-01-2010 06',
'MON-DD-YYYY HH24') And (eprocend < (to_timestamp('Aug-05-2010 23',
'MON-DD-YYYY HH24') + interval '6' hour)))
strQuery = strQuery & _
" (PROJECT_ID LIKE '" & inpProject & "')" & _
" AND (START_TIME >= to_timestamp('" & inpDateS & " 06', 'MON-DD-YYYY HH24')" & _
" AND (END_TIME < (to_timestamp('" & inpDateE & " 23', 'MON-DD-YYYY HH24') + interval '6' hour)))" & _
"ORDER BY START_TIME, TASK_ID"
Set rstTask = AdoConn.Execute(strQuery)
tCnt = 0
'ReDim TaskID(tCnt)
If Not (rstTask.EOF And rstTask.BOF) Then
rstTask.MoveFirst
Do While Not rstTask.EOF
'For dCnt = 1 To UBound(S2.Day())
'if the record is within the day
' If CDate(rstTask.Fields("START_TIME").Value) = CDate(S2.Day(dCnt)) Then
ReDim Preserve DataRecord(tCnt)
DataRecord(tCnt).TaskID = rstTask.Fields("TASK_ID").Value
DataRecord(tCnt).StartTime = rstTask.Fields("START_TIME").Value
DataRecord(tCnt).EndTime = rstTask.Fields("END_TIME").Value
DataRecord(tCnt).Description = rstTask.Fields("DESCRIPTION").Value
DataRecord(tCnt).ProjectID = rstTask.Fields("PROJECT_ID").Value
DataRecord(tCnt).DomainID = rstTask.Fields("DOMAIN_ID").Value
DataRecord(tCnt).RoleID = rstTask.Fields("ROLE_ID").Value
DataRecord(tCnt).NextTask = rstTask.Fields("NEXT_TASK").Value
'***DataRecord(tCnt).Cost = rstTask.Fields("COST").Value
If rstTask.Fields("COST").Value = Null Then
DataRecord(tCnt).Cost = ""
End If
If rstTask.Fields("MEASUREMENT_UNIT").Value = Null Then
DataRecord(tCnt).MeasurementUnit = ""
End If
'***DataRecord(tCnt).MeasurementUnit = rstTask.Fields("MEASUREMENT_UNIT").Value
DataRecord(tCnt).duration = rstTask.Fields("TOTAL_MINUTES_WORKED").Value
DataRecord(tCnt).CompletedUnit = rstTask.Fields("COMPLETED_UNITS").Value
DataRecord(tCnt).TotalWaitTime = rstTask.Fields("TOTAL_WAITING_TIME").Value
DataRecord(tCnt).CompletedWork = rstTask.Fields("COMPLETED_WORK").Value
'***DataRecord(tCnt).ErrorUnit = rstTask.Fields("ERROR_UNITS").Value
If rstTask.Fields("ERROR_UNITS").Value = Null Then
DataRecord(tCnt).ErrorUnit = ""
End If
If IsNull(rstTask.Fields("RESOURCE_NAME").Value) Then
DataRecord(tCnt).ResourceName = ""
Else
DataRecord(tCnt).ResourceName = rstTask.Fields("RESOURCE_NAME").Value
End If
DataRecord(tCnt).MinWaitTime = rstTask.Fields("MIN_WAIT_TIME").Value
DataRecord(tCnt).MaxWaitTime = rstTask.Fields("MAX_WAIT_TIME").Value
DataRecord(tCnt).AveWaitTime = rstTask.Fields("AVE_WAIT_TIME").Value
If IsNull(rstTask.Fields("MODE_WAIT_TIME").Value) Then
DataRecord(tCnt).ModeWaitTime = ""
Else
DataRecord(tCnt).ModeWaitTime = rstTask.Fields("MODE_WAIT_TIME").Value
End If
DataRecord(tCnt).MinProcTime = rstTask.Fields("MIN_PROC_TIME").Value
DataRecord(tCnt).MaxProcTime = rstTask.Fields("MAX_PROC_TIME").Value
DataRecord(tCnt).AveProcTime = rstTask.Fields("AVE_PROC_TIME").Value
If IsNull(rstTask.Fields("MODE_PROC_TIME").Value) Then
DataRecord(tCnt).ModeProcTime = ""
Else
DataRecord(tCnt).ModeProcTime = rstTask.Fields("MODE_PROC_TIME").Value
End If
' DataRecord(tCnt).ModeProcTime = rstTask.Fields("MODE_PROC_TIME").Value
rstTask.MoveNext
tCnt = tCnt + 1
' End If
'Next dCnt
Loop
End If
Set rstTask = Nothing
End Sub
Public Sub S2_Sort()
'loop day
For dCnt = 1 To UBound(S2.Day())
ReDim S2.Day(dCnt).tList(0)
'loop shift
For tCnt = 1 To UBound(TaskID())
ReDim Preserve S2.Day(dCnt).tList(tCnt)
ReDim Preserve S2.Day(dCnt).tList(tCnt).sList(0)
'dicShift.RemoveAll
'loop task
For sCnt = 1 To UBound(Shift())
ReDim Preserve S2.Day(dCnt).tList(tCnt).sList(sCnt)
ReDim Preserve S2.Day(dCnt).tList(tCnt).sList(sCnt).TaskRecList(0)
'query with paramaters for project, datetime, and taskid
strQuery = "SELECT * FROM PROD_DB WHERE PROJECT_ID = '" & inpProject & "'" & _
" AND " & GetTimestamp(S2.Day(dCnt).DayVal, Shift(sCnt).NextDay, True, Shift(sCnt).StartHour, _
Shift(sCnt).HourLen) & _
" AND TASK_ID = '" & TaskID(tCnt).TaskID & "'" & _
" ORDER BY START_TIME, TASK_ID"
Set rstInfo = AdoConn.Execute(strQuery)
If Not (rstInfo.EOF And rstInfo.BOF) Then
rstInfo.MoveFirst
wCnt = 0
Do Until rstInfo.EOF
wCnt = wCnt + 1
ReDim Preserve S2.Day(dCnt).tList(tCnt).sList(sCnt).TaskRecList(wCnt)
'save the records to a arraylist datarecord
Call SetDataRecord(rstInfo, wCnt)
'then compute, get the work time number and list it on stLIst
S2.Day(dCnt).tList(tCnt).sList(sCnt).Val = S2_Compute(S2.Day(dCnt).tList(tCnt).sList(sCnt).TaskRecList(wCnt), S2.Day(dCnt).tList(tCnt).sList(sCnt).Val)
S2.Day(dCnt).tList(tCnt).Val = S2_Compute(S2.Day(dCnt).tList(tCnt).sList(sCnt).TaskRecList(wCnt), S2.Day(dCnt).tList(tCnt).Val)
'S2.Day(dCnt).tList(tCnt).MstUnit = DataRecord(X).MeasurementUnit
'S2.Day(dCnt).tList(tCnt).Cost = DataRecord(X).Cost
S2.Day(dCnt).tList(tCnt).ResourceName = S2.Day(dCnt).tList(tCnt).ResourceName + S2.Day(dCnt).tList(tCnt).sList(sCnt).TaskRecList(wCnt).ResourceName
S2.Day(dCnt).Val = S2_Compute(S2.Day(dCnt).tList(tCnt).sList(sCnt).TaskRecList(wCnt), S2.Day(dCnt).Val)
rstInfo.MoveNext
Loop
End If
Set rstInfo = Nothing
Next sCnt 'Next Shift
Next tCnt 'Next Task
Next dCnt 'Next Day
End Sub
Private Function setStandard(Rec As Double) 'udt_DTSS_VAL
Dim m As Integer
'Rec.duration / Rec.CompletedWork
If inpOpt = "Duration" Then
stdDuration = Rec.duration + stdDuration
stdWork = stdWork + Rec.CompletedWork
ElseIf inpOpt = "Min Proc Time" Then
m = Rec.MinProcTime / Rec.CompletedWork
'minimum
If stdMinTime = 0 Then
stdMinTime = m
Else
If m < stdMinTime Then
stdMinTime = m
End If
End If
ElseIf inpOpt = "Max Proc Time" Then
m = Rec.MaxProcTime / Rec.CompletedWork
'max
If stdMaxTime = 0 Then
stdMaxTime = m
Else
If m > stdMaxTime Then
stdMaxTime = m
End If
End If
ElseIf inpOpt = "Ave Proc Time" Then
m = Rec.AveProcTime / Rec.CompletedWork
'average
'if no contents yet, assign to the datarecord
If stdAveTime = 0 Then
stdAveTime = m
Else
stdAveTime = (m + stdAveTime) / 2
End If
ElseIf inpOpt = "Mode Proc Time" Then
'store mode in array of string
'count its frequency
'null muna
'm = False
'i = 0
'ReDim Preserve Rec.ModeProcTimeVal(0)
'ReDim Preserve Rec.ModeProcTimeCount(0)
'If Rec.ModeProcTimeVal(0) = "" Then
' Rec.ModeProcTimeVal(0) = DataRecord(x).ModeProcTime
' Rec.ModeProcTimeCount(0) = 1
'Else
' Do While i < UBound(Rec.ModeProcTimeVal()) And m = False
' If Rec.ModeProcTimeVal(i) = DataRecord(x).ModeProcTime Then
' Rec.ModeProcTimeCount(i) = Rec.ModeProcTimeCount(i) + 1
' m = True
' End If
' i = i + 1
' Loop
' If m = False Then
' Rec.ModeProcTimeVal(i) = DataRecord(x).ModeProcTime
' Rec.ModeProcTimeCount(i) = Rec.ModeProcTimeCount(i) + 1
' End If
'End If
End If
End Function
Private Function S2_Compute(X As Integer, Rec As udt_DTSS_VAL) As udt_DTSS_VAL
Dim m As Boolean
'add
Rec.duration = (Rec.duration + DataRecord(X).duration)
Rec.CompletedWork = (Rec.CompletedWork + DataRecord(X).CompletedWork)
Rec.ErrorUnits = (Rec.ErrorUnits + DataRecord(X).ErrorUnit)
Rec.TotalWaitTime = (Rec.TotalWaitTime + DataRecord(X).TotalWaitTime)
Rec.CompletedUnit = (Rec.CompletedUnit + DataRecord(X).CompletedUnit)
'average
'if no contents yet, assign to the datarecord
If Rec.AveProcTime = 0 Then
Rec.AveProcTime = DataRecord(X).AveProcTime
' stdAveTime = DataRecord(x).AveProcTime
Else
Rec.AveProcTime = (Rec.AveProcTime + DataRecord(X).AveProcTime) / 2
' stdAveTime = (stdAveTime + DataRecord(x).AveProcTime) / 2
End If
If Rec.AveWaitTime = 0 Then
Rec.AveWaitTime = DataRecord(X).AveWaitTime
Else
Rec.AveWaitTime = (Rec.AveWaitTime + DataRecord(X).AveWaitTime) / 2
End If
'minimum
If Rec.MinProcTime = 0 Then
Rec.MinProcTime = DataRecord(X).MinProcTime
'stdMinTime = DataRecord(x).MinProcTime
Else
If DataRecord(X).MinProcTime < Rec.MinProcTime Then
Rec.MinProcTime = DataRecord(X).MinProcTime
End If
'If DataRecord(x).MinProcTime < stdMinTime Then
' stdMinTime = DataRecord(x).MinProcTime
'End If
End If
If Rec.MinWaitTime = 0 Then
Rec.MinWaitTime = DataRecord(X).MinWaitTime
Else
If DataRecord(X).MinWaitTime < Rec.MinWaitTime Then
Rec.MinWaitTime = DataRecord(X).MinWaitTime
End If
End If
'max
If Rec.MaxProcTime = 0 Then
Rec.MaxProcTime = DataRecord(X).MaxProcTime
Else
If DataRecord(X).MaxProcTime > Rec.MaxProcTime Then
Rec.MaxProcTime = DataRecord(X).MaxProcTime
End If
End If
If Rec.MaxWaitTime = 0 Then
Rec.MaxWaitTime = DataRecord(X).MaxWaitTime
Else
If DataRecord(X).MaxWaitTime < Rec.MaxWaitTime Then
Rec.MaxWaitTime = DataRecord(X).MaxWaitTime
End If
End If
'StartTime
If Rec.StartTime = "" Then
Rec.StartTime = DataRecord(X).StartTime
Else
If FormatDateTime(DataRecord(X).StartTime) < FormatDateTime(Rec.StartTime) Then
Rec.StartTime = DataRecord(X).StartTime
End If
End If
'EndTime
If Rec.EndTime = "" Then
Rec.EndTime = DataRecord(X).EndTime
Else
If FormatDateTime(DataRecord(X).EndTime) > FormatDateTime(Rec.EndTime) Then
Rec.EndTime = DataRecord(X).EndTime
End If
End If
'store mode in array of string
'count its frequency
m = False
i = 0
ReDim Preserve Rec.ModeProcTimeVal(0)
ReDim Preserve Rec.ModeProcTimeCount(0)
If Rec.ModeProcTimeVal(0) = "" Then
Rec.ModeProcTimeVal(0) = DataRecord(X).ModeProcTime
Rec.ModeProcTimeCount(0) = 1
Else
Do While i < UBound(Rec.ModeProcTimeVal()) And m = False
If Rec.ModeProcTimeVal(i) = DataRecord(X).ModeProcTime Then
Rec.ModeProcTimeCount(i) = Rec.ModeProcTimeCount(i) + 1
m = True
End If
i = i + 1
Loop
If m = False Then
Rec.ModeProcTimeVal(i) = DataRecord(X).ModeProcTime
Rec.ModeProcTimeCount(i) = Rec.ModeProcTimeCount(i) + 1
End If
End If
'mode wait
m = False
i = 0
ReDim Preserve Rec.ModeWaitTimeVal(0)
ReDim Preserve Rec.ModeWaitTimeCount(0)
If Rec.ModeWaitTimeVal(0) = "" Then
Rec.ModeWaitTimeVal(0) = DataRecord(X).ModeWaitTime
Rec.ModeWaitTimeCount(0) = 1
Else
Do While i < UBound(Rec.ModeWaitTimeVal()) And m = False
If Rec.ModeWaitTimeVal(i) = DataRecord(X).ModeWaitTime Then
Rec.ModeWaitTimeCount(i) = Rec.ModeWaitTimeCount(i) + 1
m = True
End If
i = i + 1
Loop
If m = False Then
Rec.ModeWaitTimeVal(i) = DataRecord(X).ModeWaitTime
Rec.ModeWaitTimeCount(i) = Rec.ModeWaitTimeCount(i) + 1
End If
End If
'generated
Rec.Generated = True
'ResourceName
'Rec.ResourceName = DataRecord(x).ResourceName
S2_Compute = Rec
End Function
Private Sub S2_ComputeMode()
For dCnt = 1 To UBound(S2.Day())
Debug.Print "Mode " & dCnt
Dim mdP As Integer, mdW As Integer
mdP = GetMax(S2.Day(dCnt).Val.ModeProcTimeCount())
mdW = GetMax(S2.Day(dCnt).Val.ModeWaitTimeCount())
ReDim Preserve S2.Day(dCnt).Val.ModeProcTimeVal(mdP)
ReDim Preserve S2.Day(dCnt).Val.ModeWaitTimeVal(mdW)
S2.Day(dCnt).Val.ModeProcTime = S2.Day(dCnt).Val.ModeProcTimeVal(mdP)
S2.Day(dCnt).Val.ModeWaitTime = S2.Day(dCnt).Val.ModeWaitTimeVal(mdW)
For tCnt = 1 To UBound(S2.Day(dCnt).tList())
Debug.Print "Mode " & dCnt & "-" & TaskID(tCnt).TaskID
'get mode of task(day)
'wList() = S2.Day(dCnt).tList(tCnt).Val.ModeProcTimeCount()
Dim mP As Integer, mW As Integer
mP = GetMax(S2.Day(dCnt).tList(tCnt).Val.ModeProcTimeCount())
mW = GetMax(S2.Day(dCnt).tList(tCnt).Val.ModeWaitTimeCount())
ReDim Preserve S2.Day(dCnt).tList(tCnt).Val.ModeProcTimeVal(mP)
ReDim Preserve S2.Day(dCnt).tList(tCnt).Val.ModeWaitTimeVal(mW)
S2.Day(dCnt).tList(tCnt).Val.ModeProcTime = S2.Day(dCnt).tList(tCnt).Val.ModeProcTimeVal(mP)
S2.Day(dCnt).tList(tCnt).Val.ModeWaitTime = S2.Day(dCnt).tList(tCnt).Val.ModeWaitTimeVal(mW)
'S2.Day(dCnt).tList(tCnt).Val.ModeDuration = Val(GetLevelMode(wList(), False))
For sCnt = 1 To UBound(S2.Day(dCnt).tList(tCnt).sList())
Debug.Print "Mode " & dCnt & "-" & TaskID(tCnt).TaskID & "-" & sCnt
Dim msP As Integer, msW As Integer
'getmode of task(shift)
msP = GetMax(S2.Day(dCnt).tList(tCnt).sList(sCnt).Val.ModeProcTimeCount())
msW = GetMax(S2.Day(dCnt).tList(tCnt).sList(sCnt).Val.ModeWaitTimeCount())
ReDim Preserve S2.Day(dCnt).tList(tCnt).sList(sCnt).Val.ModeProcTimeVal(msP)
ReDim Preserve S2.Day(dCnt).tList(tCnt).sList(sCnt).Val.ModeWaitTimeVal(msW)
S2.Day(dCnt).tList(tCnt).sList(sCnt).Val.ModeProcTime = S2.Day(dCnt).tList(tCnt).sList(sCnt).Val.ModeProcTimeVal(msP)
S2.Day(dCnt).tList(tCnt).sList(sCnt).Val.ModeWaitTime = S2.Day(dCnt).tList(tCnt).sList(sCnt).Val.ModeWaitTimeVal(msW)
'wList() = S2.Day(dCnt).tList(tCnt).sList(sCnt).wList()
'S2.Day(dCnt).tList(tCnt).sList(sCnt).Val.ModeEid = Val(GetLevelMode(wList(), True))
'S2.Day(dCnt).tList(tCnt).sList(sCnt).Val.ModeDuration = Val(GetLevelMode(wList(), False))
Next sCnt 'Next Task(Shift)
Next tCnt 'Next Task(Day)
Next dCnt 'Next Day
End Sub
Private Function GetMax(List() As Integer) As Integer
'Val (Math.Max(S2.Day(dCnt).tList(tCnt).Val.ModeProcTimeCount))
Dim mx As Integer, index As Integer
ReDim Preserve List(0)
mx = List(0)
index = 0
For i = 1 To UBound(List())
If (mx < List(i)) Then
mx = List(i)
index = i
End If
Next i
Debug.Print index
GetMax = index
End Function
Public Function GetTimestamp(vDate As String, vHour As String, vHourLen As String, vNextDay As Boolean, DateRecord As udtRecord) As Boolean
Dim sq As Boolean
Dim sDate As String, sss As String
Dim st As Date, et As Date, est As Date, eet As Date
'Dim i As Integer
st = FormatDateTime(DateRecord.StartTime)
et = FormatDateTime(DateRecord.EndTime)
est = FormatDateTime((vDate + " " + vHour + ":00:00"))
'If vNextDay = True Then
' sDate = DateAdd("d", 1, CDate(vDate))
'Else
' sDate = CDate(vDate)
'End If
'sss = (CInt(vHour) + CInt(vHourLen))
eet = FormatDateTime(DateAdd("h", vHourLen, est))
sq = (et > est) And (et <= eet)
'sQ = " END_TIME >= to_timestamp('" & sDate & "','MON-DD-YYYY HH24')" & _
" AND END_TIME < (to_timestamp('" & sDate & "','MON-DD-YYYY HH24') " & _
" + interval '" & vHourLen & "' hour)"
'sQ = " h.eprocend >= to_timestamp('" & sDate & " " & Format(vHour, "00") & "','MON-DD-YYYY HH24')" & _
" AND h.eprocend < (to_timestamp('" & sDate & " " & Format(vHour, "00") & "','MON-DD-YYYY HH24') " & _
" + interval '" & vHourLen & "' hour)"
GetTimestamp = sq
''SELECT * FROM PROD_DB WHERE (TASK_ID like 'W14') AND (END_TIME>= to_timestamp('Dec-07-2011 06','MON-DD-YYYY HH24') AND END_TIME < (to_timestamp('Dec-07-2011 06','MON-DD-YYYY HH24') + interval '4' hour))
End Function
答案 0 :(得分：0)
默认情况下，VB6中的所有参数都称为ByRef。要明确地编写它，需要调用ByVal。
如果通过引用将参数传递给函数或子过程， 传递的实际参数的类型和相应的函数 参数必须匹配。否则，您将获得“ByRef参数类型 不匹配“错误。
How to Avoid the "ByRef Argument Type Mismatch" Error
您的代码太长，无法在不知道确切的异常行的情况下查找正在发生的事情。 只是一个提示就是这一行：
Call SetDataRecord(rstInfo, wCnt)
已交换参数。