All pastes #502245 Raw Edit

Untitled

public text v1 · immutable
·published 2007-05-22 12:48 UTC
rendered paste body
Private Sub cmdEXPORT_Click()
    On Error GoTo errHandler
    
    Dim Eexcel As New excel.Application
    Dim EWorkBook As New excel.Workbook
    Dim EWorksheet As excel.Worksheet
    
    Dim iRow As Integer
    Dim iCol As Integer
    Dim iCount As Integer
    Dim bCritical As Boolean
    
    Dim iSheetRow As Integer
    
    Dim rsTemp As Recordset
    
    Timer1.Interval = 0
    Screen.MousePointer = 11
    
    Set Eexcel = New excel.Application
    Set EWorkBook = Eexcel.Workbooks.Add
    Set EWorksheet = EWorkBook.ActiveSheet
    Eexcel.Visible = True
        
    iSheetRow = 1
    
    EWorksheet.Cells(1, 1) = "ID"
    EWorksheet.Cells(1, 2) = "Date Issued"
    EWorksheet.Cells(1, 3) = "Details"
    EWorksheet.Cells(1, 4) = "Due Date"
    EWorksheet.Cells(1, 5) = "Issued By"
    EWorksheet.Cells(1, 6) = "Completed"
    EWorksheet.Cells(1, 7) = "To"
    EWorksheet.Cells(1, 8) = "Critical"
    EWorksheet.Cells(1, 9) = "Notes"
    EWorksheet.Cells(1, 10) = "Completed Date"
    EWorksheet.Cells(1, 11) = "Meeting Title"
    
    For iRow = 1 To lstCVIS.Rows - 1
        lstCVIS.Row = iRow
        bCritical = False
        If lstCVIS.RowHeight(iRow) > 0 Then
            Set rsTemp = Nothing
            Set rsTemp = conntemp.Execute("SELECT * FROM TB_CVIs WHERE id = " & lstCVIS.TextMatrix(iRow, 0) & ";")
            
            If Not rsTemp.EOF Then
                If Not IsNull(rsTemp("id")) Then
                    EWorksheet.Cells(iRow + 1, 1) = CStr(rsTemp("id"))
                End If
                If Not IsNull(rsTemp("createdate")) Then
                    EWorksheet.Cells(iRow + 1, 2) = Format$(rsTemp("createdate"), "DD MMM YYYY")
                End If
                If Not IsNull(rsTemp("details")) Then
                    EWorksheet.Cells(iRow + 1, 3) = CStr(rsTemp("details"))
                End If
                If Not IsNull(rsTemp("duedate")) Then
                    EWorksheet.Cells(iRow + 1, 4) = Format$(rsTemp("duedate"), "DD MMM YYYY")
                End If
                If Not IsNull(rsTemp("createdby")) Then
                    EWorksheet.Cells(iRow + 1, 5) = CStr(rsTemp("createdby"))
                End If
                If Not IsNull(rsTemp("completed")) Then
                    If CStr(rsTemp("completed")) = "TRUE" Then
                        EWorksheet.Cells(iRow + 1, 6) = "Yes"
                    Else
                        EWorksheet.Cells(iRow + 1, 6) = "No"
                    End If
                End If
                If Not IsNull(rsTemp("username")) Then
                    EWorksheet.Cells(iRow + 1, 7) = CStr(rsTemp("username"))
                End If
                If Not IsNull(rsTemp("critical")) Then
                    If CStr(rsTemp("critical")) = "TRUE" Then
                        EWorksheet.Cells(iRow + 1, 8) = "Yes"
                    Else
                        EWorksheet.Cells(iRow + 1, 8) = "No"
                    End If
                End If
                If Not IsNull(rsTemp("notes")) Then
                    EWorksheet.Cells(iRow + 1, 9) = CStr(rsTemp("notes"))
                End If
                If Not IsNull(rsTemp("completeddate")) Then
                    EWorksheet.Cells(iRow + 1, 10) = Format$(rsTemp("completeddate"), "DD MMM YYYY")
                End If
                If Not IsNull(rsTemp("meetingTitle")) Then
                    EWorksheet.Cells(iRow + 1, 11) = CStr(rsTemp("meetingTitle"))
                End If
            End If

        End If ' from if we are processing this row
    Next
    EWorksheet.Columns("C:C").ColumnWidth = 100.86

    
    Screen.MousePointer = 0
    Timer1.Interval = lTimer
    Exit Sub
errHandler:

    MsgBox "Error in frmCVIMAIN.cmdEXPORT_Click (" & Err.Description & ")"
    End
End Sub