P
pbuscio
Hi, I am getting this error and i don't know why. It was working then all of a sudden stopped. I have a button on a form that runs a macro that runs two codes then a macro. When i click the button, i get the error. However, if i go into the first macro and run it i get no error. Below is the code inquestion. Any ideas would help. Thanks
Function runSE16Wkly()
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMRP As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String, strPlanner As String
Dim strDate As Date
' Replace PutEXCELFileNameHereWithoutdotxls with actual EXCEL
' filename without the .xls extension
' (for example, MyEXCELFileName, BUT NOT MyEXCELFileName.xls)
Const strFileName As String = "SE16_"
Const strQName As String = "zExportQuery5"
strDate = Date
Set dbs = CurrentDb
' Create temporary query that will be used for exporting data;
' we give it a dummy SQL statement initially (this name will
' be changed by the code to conform to each manager's identification)
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
' Get list of ManagerID values -- note: replace my generic table and field names
' with the real names of the EmployeesTable table and the ManagerID field
strSQL = "SELECT DISTINCT tblMRPCn.Planner, tblMRPCn.MRPCn FROM tblMRPCn;"
Set rstMRP = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
' Now loop through list of ManagerID values and create a query for each ManagerID
' so that the data can be exported -- the code assumes that the actual names
' of the managers are in a lookup table -- again, replace generic names with
' real names of tables and fields
If rstMRP.EOF = False And rstMRP.BOF = False Then
rstMRP.MoveFirst
Do While rstMRP.EOF = False
' *** code to set strMgr needs to be changed to conform to your
' *** database design -- ManagerNameField, ManagersTable, and
' *** ManagerID need to be changed to your table and field names
' *** be changed to your table and field names
strMRP = DLookup("MRPCn", "tblMRPCn", _
"MRPCn = '" & rstMRP!MRPCn.Value & "'")
strPlanner = DLookup("Planner", "tblMRPCn", _
"Planner = '" & rstMRP!Planner.Value & "'")
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID, EmployeesTable need to
' *** be changed to your table and field names
' strSQL = "SELECT * FROM EmployeesTable WHERE " & _
"Planner = " & rstMRP!Planner.Value & ";"
strSQL = "SELECT qrySE16_1.[Actual Rel], qrySE16_1.MRPC, qrySE16_1.PurchReq, qrySE16_1.Item, qrySE16_1.Material, " & _
"qrySE16_1.[Material Description], qrySE16_1.WBS, qrySE16_1.Usage, qrySE16_1.[Release dt], qrySE16_1.[Del Date], qrySE16_1.SPlt, " & _
"qrySE16_1.[Doc Type], qrySE16_1.[Qty in Blk Stk], qrySE16_1.Qty, qrySE16_1.Excess, qrySE16_1.PGr, qrySE16_1.PDT, qrySE16_1.[Valid Rev], qrySE16_1.AltVendor1, qrySE16_1.AltVendor2," & _
"qrySE16_1.[Preservation Requirement], " & _
"qrySE16_1.[Packaging Requirement], qrySE16_1.[Identification Requirement], qrySE16_1.[Status Text], " & _
"qrySE16_1.[Special Process], qrySE16_1.[Contracted Vendor], qrySE16_1.[Last Vendor Name], qrySE16_1.[Prd Line], tblMRPCn.Planner" & _
" FROM qrySE16_1 INNER JOIN tblMRPCn ON qrySE16_1.MRPC = tblMRPCn.MRPCn" & _
" WHERE (((tblMRPCn.MRPCn)='" & rstMRP!MRPCn.Value & "'))" & _
" GROUP BY qrySE16_1.[Actual Rel], qrySE16_1.MRPC, qrySE16_1.PurchReq, qrySE16_1.Item, qrySE16_1.Material, " & _
"qrySE16_1.[Material Description], qrySE16_1.WBS, qrySE16_1.Usage, qrySE16_1.[Release dt], qrySE16_1.[Del Date], qrySE16_1.SPlt, " & _
"qrySE16_1.[Doc Type], qrySE16_1.[Qty in Blk Stk], qrySE16_1.Qty, qrySE16_1.Excess, qrySE16_1.PGr, qrySE16_1.PDT, qrySE16_1.[Valid Rev], qrySE16_1.AltVendor1, qrySE16_1.AltVendor2," & _
"qrySE16_1.[Preservation Requirement], " & _
"qrySE16_1.[Packaging Requirement], qrySE16_1.[Identification Requirement], qrySE16_1.[Status Text], " & _
"qrySE16_1.[Special Process], qrySE16_1.[Contracted Vendor], qrySE16_1.[Last Vendor Name], qrySE16_1.[Prd Line], tblMRPCn.Planner" & _
" ORDER BY qrySE16_1.MRPC, qrySE16_1.[Release dt], qrySE16_1.Material;"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "qry_" & strMRP
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
' Replace C:\FolderName\ with actual path
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strTemp, "I:\Materials Management\Master Planning\Measurement Reports\SE16 Report\SE16 By Planner\" & strFileName & strPlanner & ".xls"
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strTemp, "I:\Materials Management\Pat B\" & strFileName & ".xls"&
rstMRP.MoveNext
Loop
End If
rstMRP.Close
Set rstMRP = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
End Function
Function runSE16Wkly()
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMRP As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String, strPlanner As String
Dim strDate As Date
' Replace PutEXCELFileNameHereWithoutdotxls with actual EXCEL
' filename without the .xls extension
' (for example, MyEXCELFileName, BUT NOT MyEXCELFileName.xls)
Const strFileName As String = "SE16_"
Const strQName As String = "zExportQuery5"
strDate = Date
Set dbs = CurrentDb
' Create temporary query that will be used for exporting data;
' we give it a dummy SQL statement initially (this name will
' be changed by the code to conform to each manager's identification)
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID and EmployeesTable need to
' *** be changed to your table and field names
' Get list of ManagerID values -- note: replace my generic table and field names
' with the real names of the EmployeesTable table and the ManagerID field
strSQL = "SELECT DISTINCT tblMRPCn.Planner, tblMRPCn.MRPCn FROM tblMRPCn;"
Set rstMRP = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)
' Now loop through list of ManagerID values and create a query for each ManagerID
' so that the data can be exported -- the code assumes that the actual names
' of the managers are in a lookup table -- again, replace generic names with
' real names of tables and fields
If rstMRP.EOF = False And rstMRP.BOF = False Then
rstMRP.MoveFirst
Do While rstMRP.EOF = False
' *** code to set strMgr needs to be changed to conform to your
' *** database design -- ManagerNameField, ManagersTable, and
' *** ManagerID need to be changed to your table and field names
' *** be changed to your table and field names
strMRP = DLookup("MRPCn", "tblMRPCn", _
"MRPCn = '" & rstMRP!MRPCn.Value & "'")
strPlanner = DLookup("Planner", "tblMRPCn", _
"Planner = '" & rstMRP!Planner.Value & "'")
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID, EmployeesTable need to
' *** be changed to your table and field names
' strSQL = "SELECT * FROM EmployeesTable WHERE " & _
"Planner = " & rstMRP!Planner.Value & ";"
strSQL = "SELECT qrySE16_1.[Actual Rel], qrySE16_1.MRPC, qrySE16_1.PurchReq, qrySE16_1.Item, qrySE16_1.Material, " & _
"qrySE16_1.[Material Description], qrySE16_1.WBS, qrySE16_1.Usage, qrySE16_1.[Release dt], qrySE16_1.[Del Date], qrySE16_1.SPlt, " & _
"qrySE16_1.[Doc Type], qrySE16_1.[Qty in Blk Stk], qrySE16_1.Qty, qrySE16_1.Excess, qrySE16_1.PGr, qrySE16_1.PDT, qrySE16_1.[Valid Rev], qrySE16_1.AltVendor1, qrySE16_1.AltVendor2," & _
"qrySE16_1.[Preservation Requirement], " & _
"qrySE16_1.[Packaging Requirement], qrySE16_1.[Identification Requirement], qrySE16_1.[Status Text], " & _
"qrySE16_1.[Special Process], qrySE16_1.[Contracted Vendor], qrySE16_1.[Last Vendor Name], qrySE16_1.[Prd Line], tblMRPCn.Planner" & _
" FROM qrySE16_1 INNER JOIN tblMRPCn ON qrySE16_1.MRPC = tblMRPCn.MRPCn" & _
" WHERE (((tblMRPCn.MRPCn)='" & rstMRP!MRPCn.Value & "'))" & _
" GROUP BY qrySE16_1.[Actual Rel], qrySE16_1.MRPC, qrySE16_1.PurchReq, qrySE16_1.Item, qrySE16_1.Material, " & _
"qrySE16_1.[Material Description], qrySE16_1.WBS, qrySE16_1.Usage, qrySE16_1.[Release dt], qrySE16_1.[Del Date], qrySE16_1.SPlt, " & _
"qrySE16_1.[Doc Type], qrySE16_1.[Qty in Blk Stk], qrySE16_1.Qty, qrySE16_1.Excess, qrySE16_1.PGr, qrySE16_1.PDT, qrySE16_1.[Valid Rev], qrySE16_1.AltVendor1, qrySE16_1.AltVendor2," & _
"qrySE16_1.[Preservation Requirement], " & _
"qrySE16_1.[Packaging Requirement], qrySE16_1.[Identification Requirement], qrySE16_1.[Status Text], " & _
"qrySE16_1.[Special Process], qrySE16_1.[Contracted Vendor], qrySE16_1.[Last Vendor Name], qrySE16_1.[Prd Line], tblMRPCn.Planner" & _
" ORDER BY qrySE16_1.MRPC, qrySE16_1.[Release dt], qrySE16_1.Material;"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "qry_" & strMRP
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
' Replace C:\FolderName\ with actual path
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strTemp, "I:\Materials Management\Master Planning\Measurement Reports\SE16 Report\SE16 By Planner\" & strFileName & strPlanner & ".xls"
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strTemp, "I:\Materials Management\Pat B\" & strFileName & ".xls"&
rstMRP.MoveNext
Loop
End If
rstMRP.Close
Set rstMRP = Nothing
dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
End Function