Results 1 to 3 of 3
  1. #1
    Join Date
    Aug 2004
    Location
    Right Here.
    Posts
    3

    Unanswered: Nested do loop reading table column

    I've included the code I am trying to create to run through a set of do loops. This code worked fine to generate data in excel prior to me adding the top level do loop. I am trying to incorporate a variable strSPLR into my sql so that it creates a seperate worksheet in excel for each SPLR_CODE in my T_SPLR_INFO table.

    The error I get is "compile error: loop without do", but I have both in the code. I must be missing something.

    I am new to nesting so I'm sure that is the issue. Any help would be appreciated. Thanks in advance.



    Public Sub ExportOSStatus()
    On Error GoTo ErrorHandler

    Dim xlx As Object
    Dim WorksheetRow As Integer, StartRow As Integer, intLine As Integer, strOSStatus As String, strOSSplr As String, strWS As String, strSPLR As String, rs As DAO.Recordset, rs2 As DAO.Recordset

    DoCmd.Hourglass True
    strOSSplr = "SELECT T_SPLR_INFO.SPLR_CODE " & _
    "FROM T_SPLR_INFO " & _
    "ORDER BY T_SPLR_INFO.SPLR_CODE;"

    'Start import into worksheet 1
    strWS = 1
    Set rs2 = CurrentDb.OpenRecordset(strOSSplr, dbOpenSnapshot)

    If rs2.RecordCount > 0 Then
    Do Until rs2.EOF
    strSPLR = rs2!SPLR_CODE

    strOSStatus = "SELECT T_OS_INFO.SPLR_CODE, T_JOB_ENTRY_LOG.FOLDER_NUM, T_OS_INFO.CREATED_DATE AS SCR_CREATE_DATE, " & _
    "T_OS_INFO.RD_QUOTE_HRS_AGREED_DATE AS APPROVAL_DATE, T_OS_ITEMS.DATE_SENT, T_OS_ITEMS.DATE_RCVD, T_OS_INFO.SCR_COMP_DATE, " & _
    "T_JOB_ENTRY_LOG.REV_CAD_EST_DATE, T_JOB_ENTRY_LOG.PRIMARY_ID, First(T_JOB_ENTRY_LOG.JOB_DESC) AS [DESC] " & _
    "FROM T_OS_ITEMS INNER JOIN (T_OS_INFO INNER JOIN T_JOB_ENTRY_LOG ON T_OS_INFO.FOLDER_NUM = T_JOB_ENTRY_LOG.FOLDER_NUM) ON " & _
    "T_OS_ITEMS.OS_NUM = T_OS_INFO.OS_NUM " & _
    "GROUP BY T_OS_INFO.SPLR_CODE, T_JOB_ENTRY_LOG.FOLDER_NUM, T_OS_INFO.CREATED_DATE, T_OS_INFO.RD_QUOTE_HRS_AGREED_DATE, T_OS_ITEMS.DATE_SENT, " & _
    "T_OS_ITEMS.DATE_RCVD, T_OS_INFO.SCR_COMP_DATE, T_JOB_ENTRY_LOG.REV_CAD_EST_DATE, T_JOB_ENTRY_LOG.PRIMARY_ID, T_OS_INFO.SPLR_TYPE, " & _
    "T_JOB_ENTRY_LOG.JOB_COMP_DATE, T_JOB_ENTRY_LOG.OS_SUPPORT " & _
    "HAVING (((T_OS_INFO.SPLR_CODE)=" & strSPLR & ") AND ((T_OS_INFO.CREATED_DATE) is not Null) And ((T_OS_INFO.SPLR_TYPE) = 'ESP-RD' Or (T_OS_INFO.SPLR_TYPE) = 'ESP-SB') " & _
    "And ((T_JOB_ENTRY_LOG.JOB_COMP_DATE) is Null) And ((T_JOB_ENTRY_LOG.OS_SUPPORT) = 'Y')) " & _
    "ORDER BY T_OS_INFO.SPLR_CODE, T_JOB_ENTRY_LOG.FOLDER_NUM, T_OS_INFO.SPLR_TYPE, T_OS_INFO.CREATED_DATE;"

    WorksheetRow = 4
    StartRow = WorksheetRow
    intLine = 1

    Set rs = CurrentDb.OpenRecordset(strOSStatus, dbOpenSnapshot)

    If rs.RecordCount > 0 Then
    Set xlx = CreateObject("excel.application")
    With xlx.Application
    'Open the workbook
    Dim DirGet As String
    DirGet = DLookup("[ATTRIBUTE_1]", "T_ATTRIBUTES", "CODE = 'DIR_GET'")
    .workbooks.Open (DirGet & "OS_Job_StatusTemplate.xls")

    With xlx.Application.Worksheets(strWS)
    .Range("A1").Value = "Generated on " & Date & " at " & Time()

    Do Until rs.EOF
    .Range("A" & WorksheetRow).Value = intLine
    .Range("B" & WorksheetRow).Value = rs!FOLDER_NUM
    .Range("C" & WorksheetRow).Value = rs!SCR_CREATE_DATE
    .Range("D" & WorksheetRow).Value = rs!APPROVAL_DATE
    .Range("E" & WorksheetRow).Value = rs!DATE_SENT
    .Range("F" & WorksheetRow).Value = rs!DATE_RCVD
    '.Range("G" & WorksheetRow).Value = rs!SUBMITTED_TO_CHK
    .Range("H" & WorksheetRow).Value = rs!SCR_COMP_DATE
    .Range("I" & WorksheetRow).Value = rs!REV_CAD_EST_DATE
    .Range("J" & WorksheetRow).Value = rs!PRIMARY_ID
    .Range("K" & WorksheetRow).Value = rs!DESC
    rs.MoveNext
    WorksheetRow = WorksheetRow + 1
    intLine = intLine + 1
    Loop
    .Range("A" & WorksheetRow + 1 & ":H" & WorksheetRow + 1).Font.Bold = True
    .Range("A" & WorksheetRow + 1 & ":H" & WorksheetRow + 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Range("A" & WorksheetRow + 1 & ":H" & WorksheetRow + 1).Borders(xlEdgeTop).LineStyle = xlContinuous
    .Range("A" & WorksheetRow + 1).Value = "Totals:"
    .Range("B" & WorksheetRow + 1 & ":K" & WorksheetRow + 1).NumberFormat = "0"
    .Range("B" & WorksheetRow + 1).Value = "=COUNTA(B" & StartRow & ":B" & WorksheetRow - 1 & ")"
    .Range("C" & WorksheetRow + 1).Value = "=COUNT(C" & StartRow & ":C" & WorksheetRow - 1 & ")-COUNT(D" & StartRow & "" & WorksheetRow - 1 & ")"
    .Range("D" & WorksheetRow + 1).Value = "=COUNT(D" & StartRow & "" & WorksheetRow - 1 & ")-COUNT(E" & StartRow & ":E" & WorksheetRow - 1 & ")"
    .Range("E" & WorksheetRow + 1).Value = "=COUNT(E" & StartRow & ":E" & WorksheetRow - 1 & ")-COUNT(F" & StartRow & ":F" & WorksheetRow - 1 & ")"
    .Range("F" & WorksheetRow + 1).Value = "=COUNT(F" & StartRow & ":F" & WorksheetRow - 1 & ")-COUNT(G" & StartRow & ":G" & WorksheetRow - 1 & ")"
    .Range("G" & WorksheetRow + 1).Value = "=COUNT(G" & StartRow & ":G" & WorksheetRow - 1 & ")-COUNT(H" & StartRow & ":H" & WorksheetRow - 1 & ")"
    .Range("H" & WorksheetRow + 1).Value = "=COUNT(H" & StartRow & ":H" & WorksheetRow - 1 & ")"

    End With
    .Visible = True
    DoCmd.Hourglass False

    'Setup directory to save excel file, then saveas
    Dim DirSave As String
    DirSave = DLookup("[ATTRIBUTE_1]", "T_ATTRIBUTES", "CODE = 'DIR_SAVE'")
    .ActiveWorkbook.SaveAs Filename:=DirSave & "OS_Job_Status_" & Format(Date, "mm-dd-yy") & ".xls"

    End With

    'Move to Next Worksheet
    rs2.MoveNext
    strWS = strWS + 1
    Loop


    Set xlx = Nothing
    Else
    MsgBox "No data available.", vbExclamation, "No Data Available"

    End If

    DoCmd.Hourglass False

    Exit_ExportOSStatus:
    Exit Sub

    ErrorHandler:
    Set xlx = Nothing
    DoCmd.Hourglass False
    MsgBox Err.Description
    Resume Exit_ExportOSStatus

    End Sub

  2. #2
    Join Date
    Aug 2004
    Posts
    7
    The second end with should be and end if

    P.S. You should always indent your code.

    .ActiveWorkbook.SaveAs Filename:=DirSave & "OS_Job_Status_" & Format(Date, "mm-dd-yy") & ".xls"

    end if ' not End With

    'Move to Next Worksheet
    rs2.MoveNext

  3. #3
    Join Date
    Nov 2003
    Posts
    1,487
    I think your End With's are OK....you're obviously missing a End If though. Place it under your last End With.



Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •