Bedankt voor je reactie. Helaas is je antwoord te veel abracadabra voor me. Ligt niet aan jou, maar door mijn gebrek aan kennis. Ik kan er niet veel mee.
Wat ik wel kan doen is hieronder meer info neerzetten zodat je kunt bekijken wat er mis is:
Qry Behoefte CO 6weeks (deze geeft de foutmelding)[/B]SQL:
TRANSFORM Sum([Qry CO 6 weeks_sub1].Open) AS [Open]
SELECT [Qry CO 6 weeks_sub1].LPROD, [Qry CO 6 weeks_sub1].IDESC, Sum([Qry CO 6 weeks_sub1].LQORD) AS [Order], Sum([Qry CO 6 weeks_sub1].LQSHP) AS Shipped, Sum([Qry CO 6 weeks_sub1].Open) AS OpenTotaal
FROM [Qry CO 6 weeks_sub1] LEFT JOIN work_IIM ON [Qry CO 6 weeks_sub1].LPROD = work_IIM.IPROD
WHERE (((work_IIM.IVEND)=10118))
GROUP BY [Qry CO 6 weeks_sub1].LPROD, [Qry CO 6 weeks_sub1].IDESC
ORDER BY [Qry CO 6 weeks_sub1].LPROD, [Qry CO 6 weeks_sub1].WeekOffSet
PIVOT [Qry CO 6 weeks_sub1].WeekOffSet In (0,1,2,3,4,5,6);
Je had het ook over modules.
In de database staan 3 modules:
Mdl DatumTijdFuncties:
Option Compare Database
Function BeginDatumPrdWeek(yyyyww As String) As Date
Dim db As Database
Dim qdfPrdWeek As QueryDef
Dim rstPrdWeek As Recordset
Set db = OpenDatabase("S:\Database\Access\BPCS_Data\BPCS_Data.mdb")
Set qdfPrdWeek = db.QueryDefs("Qry DataPrdWeek")
Set rstPrdWeek = qdfPrdWeek.OpenRecordset
rstPrdWeek.FindFirst ("[Prd_yyyy-ww] = '" & yyyyww & "'")
BeginDatumPrdWeek = rstPrdWeek!BeginDatum
rstPrdWeek.Close
qdfPrdWeek.Close
db.Close
End Function
Function EindDatumPrdWeek(yyyyww As String) As Date
Dim db As Database
Dim qdfPrdWeek As QueryDef
Dim rstPrdWeek As Recordset
Set db = OpenDatabase("S:\Database\Access\BPCS_Data\BPCS_Data.mdb")
Set qdfPrdWeek = db.QueryDefs("Qry DataPrdWeek")
Set rstPrdWeek = qdfPrdWeek.OpenRecordset
rstPrdWeek.FindFirst ("[Prd_yyyy-ww] = '" & yyyyww & "'")
EindDatumPrdWeek = rstPrdWeek!EindDatum
rstPrdWeek.Close
qdfPrdWeek.Close
db.Close
End Function
Function BeginDatumPeriode(yyyyff As String) As Date
Dim db As Database
Dim qdfPeriode As QueryDef
Dim rstPeriode As Recordset
Set db = OpenDatabase("S:\Database\Access\BPCS_Data\BPCS_Data.mdb")
Set qdfPeriode = db.QueryDefs("Qry DataPrd")
Set rstPeriode = qdfPeriode.OpenRecordset
rstPeriode.FindFirst ("[yyyy-ff] = '" & yyyyff & "'")
BeginDatumPeriode = rstPeriode!P_Begin
rstPeriode.Close
qdfPeriode.Close
db.Close
End Function
Function EindDatumPeriode(yyyyff As String) As Date
Dim db As Database
Dim qdfPeriode As QueryDef
Dim rstPeriode As Recordset
Set db = OpenDatabase("S:\Database\Access\BPCS_Data\BPCS_Data.mdb")
Set qdfPeriode = db.QueryDefs("Qry DataPrd")
Set rstPeriode = qdfPeriode.OpenRecordset
rstPeriode.FindFirst ("[yyyy-ff] = '" & yyyyff & "'")
EindDatumPeriode = rstPeriode!P_Eind
rstPeriode.Close
qdfPeriode.Close
db.Close
End Function
Function AddWeeks(yyyyww As String, I As Double) As String
'Restrictie van deze functie: niet meer dan 53 weken optellen/aftrekken.
Dim db As Database
Dim rstWeek53 As Recordset
Dim J As Long
Dim W As Byte
Dim WMax As Byte
Set db = CurrentDb()
Set rstWeek53 = db.OpenRecordset("tbl Week53")
J = CLng(Left$(yyyyww, 4))
W = CByte(Right$(yyyyww, 2))
WMax = 52
rstWeek53.FindFirst ("[Jaar] = " & J)
If rstWeek53!Week53 Then WMax = 53
rstWeek53.Close
db.Close
If I > 0 Then
If W + I > WMax Then
J = J + 1
W = W + I - WMax
Else
W = W + I
End If
Else
If W + I <= 0 Then
J = J - 1
W = W + I + WMax
Else
'If W <> 53 Then
' W = W + I + 1
'Else
W = W + I
'End If
End If
End If
AddWeeks = Format(J, "0000") & "-" & Format(W, "00")
End Function
Function AddPeriods(xxyyff As String, I As Single) As String
Dim X, Y As Long
Dim P As Byte
X = CLng(Left$(xxyyff, 2))
Y = CLng(Mid$(xxyyff, 3, 2))
P = CByte(Right$(xxyyff, 2))
If I > 0 Then
If P + I > 12 Then
X = X + 1
Y = Y + 1
P = P + I - 12
Else
P = P + I
End If
Else
If P + I <= 0 Then
X = X - 1
Y = Y - 1
P = P + I + 12
Else
P = P + I
End If
End If
AddPeriods = Format(X, "00") & Format(Y, "00") & "-" & Format(P, "00")
End Function
Function yyyywwNow() As String
Dim J As Long
Dim W As Byte
J = Format(Now(), "yyyy", 2, 2)
W = Format(Now(), "ww", 2, 2)
yyyywwNow = Format(J, "0000") & "-" & Format(W, "00")
End Function
Function DiffMonths(yyyymm1 As String, yyyymm2 As String)
Dim J1, J2 As Long
Dim M1, M2 As Byte
J1 = CLng(Left$(yyyymm1, 4))
M1 = CByte(Right$(yyyymm1, 2))
J2 = CLng(Left$(yyyymm2, 4))
M2 = CByte(Right$(yyyymm2, 2))
If J1 = J2 Then
DiffMonths = M2 - M1
Else
DiffMonths = (12 - M1) + M2
End If
End Function
Function DiffWeeks(yyyyww1 As String, yyyyww2 As String) As Double
Dim J1, J2 As Long
Dim W1, W2 As Byte
Dim db As Database
Dim rstWeek53 As Recordset
Dim J As Long
Dim W As Byte
Dim WMax As Byte
Set db = CurrentDb()
Set rstWeek53 = db.OpenRecordset("tbl Week53")
J = CLng(Left$(yyyyww1, 4))
W = CByte(Right$(yyyyww1, 2))
WMax = 52
rstWeek53.FindFirst ("[Jaar] = " & J)
If rstWeek53!Week53 Then WMax = 53
rstWeek53.Close
db.Close
J1 = CLng(Left$(yyyyww1, 4))
W1 = CByte(Right$(yyyyww1, 2))
J2 = CLng(Left$(yyyyww2, 4))
W2 = CByte(Right$(yyyyww2, 2))
If J1 = J2 Then
DiffWeeks = W2 - W1
Else
If J1 < J2 Then
DiffWeeks = (WMax - W1) + W2
Else
DiffWeeks = -1 * (((J1 - J2) * WMax) - W2) - W1
End If
End If
End Function
Function DiffDagen(yyyywwdd1 As Double, yyyywwdd2 As Double) As Long
Dim D1, D2 As Date
Dim P1, P2 As String
P1 = Trim(CStr(yyyywwdd1))
P2 = Trim(CStr(yyyywwdd2))
D1 = CDate(Right(P1, 2) & "/" & Mid(P1, 5, 2) & "/" & Left(P1, 4))
D2 = CDate(Right(P2, 2) & "/" & Mid(P2, 5, 2) & "/" & Left(P2, 4))
DiffDagen = DateDiff("d", D1, D2, 2, 2)
End Function
Function BPCS_Date_Now() As Long
Dim J As Long
Dim M As Byte
Dim D As Byte
J = Format(Now(), "yyyy", 2, 2)
M = Format(Now(), "mm", 2, 2)
D = Format(Now(), "dd", 2, 2)
BPCS_Date_Now = Format(J, "0000") & Format(M, "00") & Format(D, "00")
End Function
Function WeekNr_BPCS(Datum As Long)
Dim Y As Integer
Dim M As Integer
Dim D As Integer
Dim R As String
Y = Left(Trim(Str(Datum)), 4)
M = Mid(Trim(Str(Datum)), 5, 2)
D = Right(Trim(Str(Datum)), 2)
R = Format(D, "00") & "/" & Format(M, "00") & "/" & Format(Y, "0000")
WeekNr_BPCS = Format(R, "ww", vbMonday, vbFirstFourDays)
End Function
Function YYYYWW_BPCS(Datum As Long)
Dim Y As Integer
Dim M As Integer
Dim W As Integer
Dim D As Integer
Dim R As String
Y = Left(Trim(Str(Datum)), 4)
M = Mid(Trim(Str(Datum)), 5, 2)
D = Right(Trim(Str(Datum)), 2)
W = Format(Format(D, "00") & "/" & Format(M, "00") & "/" & Format(Y, "0000"), "ww", vbMonday, vbFirstFourDays)
YYYYWW_BPCS = Format(Y, "0000") & "-" & Format(W, "00")
End Function
Function GetYear_BPCS(Datum As Long)
'Query GetPeriod
Set db = CurrentDb()
Set qdfPeriod = db.QueryDefs("Qry GetPeriod")
Set prmDatum = qdfPeriod.Parameters!Datum
prmDatum = Datum
Set rstPeriod = qdfPeriod.OpenRecordset
GetYear_BPCS = rstPeriod!PLYEAR
End Function
Function TwaalfPrdVroeger(YYXXFF As String) As String
Dim Jaar1, Jaar2 As Byte
Dim Periode As Byte
Dim S As String
Jaar1 = CByte(Left(YYXXFF, 2))
Jaar2 = CByte(Mid(YYXXFF, 3, 2))
Periode = CByte(Right(YYXXFF, 2))
If Periode = 12 Then
TwaalfPrdVroeger = Format(Jaar1, "00") & Format(Jaar2, "00") & "-01"
Else
TwaalfPrdVroeger = Format(Jaar1 - 1, "00") & Format(Jaar2 - 1, "00") & "-" & Format(Periode + 1, "00")
End If
End Function
Function TwaalfPrdLater(YYXXFF As String) As String
Dim Jaar1, Jaar2 As Byte
Dim Periode As Byte
Dim S As String
Jaar1 = CByte(Left(YYXXFF, 2))
Jaar2 = CByte(Mid(YYXXFF, 3, 2))
Periode = CByte(Right(YYXXFF, 2))
If Periode = 1 Then
TwaalfPrdLater = Format(Jaar1, "00") & Format(Jaar2, "00") & "-12"
Else
TwaalfPrdLater = Format(Jaar1 + 1, "00") & Format(Jaar2 + 1, "00") & "-" & Format(Periode - 1, "00")
End If
End Function
Function ToAccessDateFormat(Dtm As Long) As Date
Dim J As Long
Dim M As Byte
Dim D As Byte
Dim S As String
J = Left(Dtm, 4)
M = Mid(Dtm, 5, 2)
D = Right(Dtm, 2)
ToAccessDateFormat = CDate(Format(D, "00") & "/" & Format(M, "00") & "/" & Format(J, "0000"))
End Function
Function ToBPCSDateFormat(Dtm As Date) As Long
Dim J As Long
Dim M As Byte
Dim D As Byte
Dim S As String
J = Format(Dtm, "yyyy", 2, 2)
M = Format(Dtm, "mm", 2, 2)
D = Format(Dtm, "dd", 2, 2)
ToBPCSDateFormat = Format(J, "0000") & Format(M, "00") & Format(D, "00")
End Function
Function xxyyffNow() As String
Dim db As Database
Dim qdfPeriods As QueryDef
Dim rstPeriods As Recordset
Set db = CurrentDb()
Set qdfPeriods = db.QueryDefs("Qry Periodes")
Set rstPeriods = qdfPeriods.OpenRecordset
rstPeriods.FindFirst "[Datum] = #" & Format(Now(), "yyyy-mm-dd") & "#"
xxyyffNow = rstPeriods!xxyypp
rstPeriods.Close
End Function
Function DiffPeriods(xxyyff1 As String, xxyyff2 As String) As Long
Dim X1, X2 As Byte
Dim Y1, Y2 As Byte
Dim FF1, FF2 As Byte
Dim P1, P2 As String
P1 = Trim(CStr(xxyyff1))
P2 = Trim(CStr(xxyyff2))
X1 = Val(Left(P1, 2))
X2 = Val(Left(P2, 2))
Y1 = Val(Mid(P1, 3, 2))
Y2 = Val(Mid(P2, 3, 2))
FF1 = Val(Right(P1, 2))
FF2 = Val(Right(P2, 2))
If (X1 = X2) Then
DiffPeriods = FF2 - FF1
Else
If X1 < X2 Then
DiffPeriods = ((X2 - X1) * 12) + (FF2 - FF1)
Else
DiffPeriods = ((X1 - X2) * 12) + (FF1 - FF2)
End If
End If
End Function
Function OffsetPeriodeNaam(Offset) As String
Dim db As Database
Dim qdfPeriods As QueryDef
Dim rstPeriods As Recordset
Dim P As Byte
Set db = CurrentDb()
Set qdfPeriods = db.QueryDefs("Qry Periodes")
Set rstPeriods = qdfPeriods.OpenRecordset
rstPeriods.FindFirst "[Datum] = #" & Format(Now(), "yyyy-mm-dd") & "#"
P = rstPeriods!Periode
rstPeriods.FindFirst "[Periode] = " & (P + Offset)
OffsetPeriodeNaam = rstPeriods!PeriodeNaam
rstPeriods.Close
End Function
Module Functies:
Option Compare Database
Function VerwijderTabel(tabelnaam As String) As Long
On Error GoTo ErrorHandler
DoCmd.DeleteObject acTable, tabelnaam
VerwijderTabel = 0
GoTo Einde
ErrorHandler:
VerwijderTabel = 9999
Einde:
On Error GoTo 0
End Function
Function ClearTabel(tabelnaam As String) As Long
On Error GoTo ErrorHandler
DoCmd.RunSQL ("DELETE * FROM [" & tabelnaam & "]")
ClearTabel = 0
GoTo Einde
ErrorHandler:
ClearTabel = 9999
Einde:
On Error GoTo 0
End Function
Module OutputQueryToFile:
' Pass the Object type: Table, Query, Form, Report, Macro, or Module
' Pass the Object Name
Function ObjectExists(db As Database, strObjectType As String, strObjectName As String) As Boolean
Dim tbl As TableDef
Dim qry As QueryDef
Dim I As Integer
ObjectExists = False
If strObjectType = "Table" Then
For Each tbl In db.TableDefs
If tbl.Name = strObjectName Then
ObjectExists = True
Exit Function
End If
Next tbl
ElseIf strObjectType = "Query" Then
For Each qry In db.QueryDefs
If qry.Name = strObjectName Then
ObjectExists = True
Exit Function
End If
Next qry
ElseIf strObjectType = "Form" Or strObjectType = "Report" Or strObjectType = "Module" Then
For I = 0 To db.Containers(strObjectType & "s").Documents.Count - 1
If db.Containers(strObjectType & "s").Documents(I).Name = strObjectName Then
ObjectExists = True
Exit Function
End If
Next I
ElseIf strObjectType = "Macro" Then
For I = 0 To db.Containers("Scripts").Documents.Count - 1
If db.Containers("Scripts").Documents(I).Name = strObjectName Then
ObjectExists = True
Exit Function
End If
Next I
Else
MsgBox "Invalid Object Type passed, must be Table, Query, Form, Report, Macro, or Module"
End If
End Function
Function GetParameters(Qry_Name, NrParams As Byte) As Variant
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rst As DAO.Recordset
Dim C As Byte
ReDim Params(NrParams + 1) As Variant
Set db = OpenDatabase("S:\Database\Access\MARS\parameters.mdb")
Set qdf = db.QueryDefs("Qry GetParameters")
qdf.Parameters(0) = Qry_Name
Set rst = qdf.OpenRecordset
rst.MoveFirst
Do
Select Case rst!ParamType
Case "S": Params(rst!Parameternr) = CStr(rst!ParamValue)
Case "N": Params(rst!Parameternr) = CDbl(rst!ParamValue)
Case "D": Params(rst!Parameternr) = CDate(rst!ParamValue)
Case "F":
Select Case UCase(Left(rst!ParamValue, 8))
Case "YYYYWWNO": Params(rst!Parameternr) = CStr(yyyywwNow())
Case "ADDWEEKS": Params(rst!Parameternr) = CStr(AddWeeks(yyyywwNow(), CDbl(Right(Trim(rst!ParamValue), 3))))
Case "PRDWEEKB": Params(rst!Parameternr) = CDate(BeginDatumPrdWeek(AddWeeks(yyyywwNow(), CDbl(Right(Trim(rst!ParamValue), 3)))))
Case "PRDWEEKE": Params(rst!Parameternr) = CDate(EindDatumPrdWeek(AddWeeks(yyyywwNow(), CDbl(Right(Trim(rst!ParamValue), 3)))))
End Select
End Select
Params(UBound(Params)) = CStr(rst!ResultsFile)
rst.MoveNext
Loop Until rst.EOF
rst.Close
qdf.Close
db.Close
Set db = Nothing
Set qdf = Nothing
Set rst = Nothing
GetParameters = Params
End Function
Function OutputQueryToFile(Qry_Name, NrParams As Byte)
Dim db As DAO.Database
Dim db_Params As DAO.Database
Dim qdf As DAO.QueryDef
Dim qdf_TEMP As DAO.QueryDef
Dim tbl As DAO.TableDef
Dim Pos As Long
Dim strSQL As String
Dim tempSQL As String
Dim Params As Variant
Dim C As Byte
Set db = CurrentDb
Set qdf = db.QueryDefs(Qry_Name)
strSQL = qdf.SQL
tempSQL = qdf.SQL
'Haal parameters op uit parameterbestand
Params = GetParameters(Qry_Name, NrParams)
'Check & delete TEMP query & file
If ObjectExists(db, "Query", "qryTEMP") Then
DoCmd.DeleteObject acQuery, "qryTEMP"
End If
If ObjectExists(db, "Table", "tblTEMP") Then
DoCmd.DeleteObject acTable, "tblTEMP"
End If
'Convert to action query
Pos = InStr(1, tempSQL, "FROM") - 1
tempSQL = Left(tempSQL, Pos - 1) & "into [tblTEMP] " & Mid(tempSQL, Pos, 10000)
'Create temp query
Set qdf_TEMP = db.CreateQueryDef("qryTEMP", tempSQL)
For C = 1 To (UBound(Params) - 1)
qdf_TEMP.Parameters(C - 1) = Params(C)
Next
'Maak tijdelijk bestand aan in huidige database
qdf_TEMP.Execute
'Verwijder tijdelijk bestand in parameter database
Set db_Params = OpenDatabase("S:\Database\Access\MARS\Parameters.mdb")
'db_Params.TableDefs.Delete (Params(UBound(Params)))
If ObjectExists(db_Params, "Table", CStr(Params(UBound(Params)))) Then
db_Params.TableDefs.Delete (CStr(Params(UBound(Params))))
End If
db_Params.Close
Set db_Params = Nothing
'Kopieer tijdelijke bestand van huidige database naar parameter database
DoCmd.RunSQL ("SELECT * INTO [" & Params(UBound(Params)) & "] IN 'S:\Database\Access\MARS\Parameters.mdb' FROM [tblTEMP]")
'Verwijder tijdelijk bestand en query uit huidige database
If ObjectExists(db, "Query", "qryTEMP") Then
DoCmd.DeleteObject acQuery, "qryTEMP"
End If
If ObjectExists(db, "Table", "tblTEMP") Then
DoCmd.DeleteObject acTable, "tblTEMP"
End If
'Sluit alle objecten
qdf.Close
qdf_TEMP.Close
db.Close
Set qdf = Nothing
Set qdf_TEMP = Nothing
Set db = Nothing
End Function
Ik hoop dat je eruit komt (en dan daarna ik :thumb: )
Mocht je meer info nodig hebben, hoor ik het graag.
Voor zover in access foutmeldingen ergens op slaan:
Ik denk dat criteriumexpressie duidt op de WHERE statement van de query. Waarschijnlijk wordt er een ingebouwde of in vba geschreven functie aangeroepen met een argument dat van het verkeerde type is.
Voorbeeld:
SELECT id FROM table WHERE Len(id)>4
Len is een functie die een tekst waarde verwacht en die krijgt nu een getal
Als het een ingebouwde functie is dan is het lastig te verhelpen
Als het een zelf toegevoegde functie is (onder modules) kan je de declaratie wijzigen
function myfunc(id as String) as Long
wordt
function myfunc(id as Number) as Long
bijvoorbeeld
Om nog even verder te gaan op mijn openingsklaagzang:
dit soort fouten kan je ook krijgen als een typelib die aan je project is toegevoegd van de harde schijf verwijderd is. (of verplaatst, etc) Je gekoppelde typelibs kan je vinden in de vba editor (alt+F11 meen ik) onder references
