return without gosub error

Discussion in 'Access Macros' started by pbuscio@comcast.net, Feb 25, 2013.

  1. Guest

    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
     
    , Feb 25, 2013
    #1
    1. Advertisements

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.
Similar Threads
  1. Con Giacomini

    Return to starting tab

    Con Giacomini, Jul 8, 2003, in forum: Access Macros
    Replies:
    0
    Views:
    102
    Con Giacomini
    Jul 8, 2003
  2. Jacquie

    return to previous record browsed

    Jacquie, Sep 12, 2003, in forum: Access Macros
    Replies:
    0
    Views:
    81
    Jacquie
    Sep 12, 2003
  3. Deanna Rains

    Detecting Line Return Character

    Deanna Rains, Oct 13, 2003, in forum: Access Macros
    Replies:
    1
    Views:
    92
    Douglas J. Steele
    Oct 13, 2003
  4. Hermanson
    Replies:
    0
    Views:
    72
    Hermanson
    Dec 9, 2003
  5. satniro

    How to return MDW filename?

    satniro, Jan 9, 2004, in forum: Access Macros
    Replies:
    1
    Views:
    111
    Douglas J. Steele
    Jan 10, 2004
  6. Evan
    Replies:
    0
    Views:
    78
  7. KR
    Replies:
    3
    Views:
    79
    Dan S.
    Mar 16, 2006
  8. Kirk P.

    2950 Return without GoSub

    Kirk P., Apr 8, 2008, in forum: Access Macros
    Replies:
    1
    Views:
    281
    Ian Mathewson
    Apr 11, 2008
Loading...