Public Class frmReportBusUnit

    Private Sub frmReportBusUnit_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        On Error GoTo Errhand
        'TODO: This line of code loads data into the 'ServerInfoDataSet.tblBusUnit' table. You can move, or remove it, as needed.
        Me.TblBusUnitTableAdapter.Fill(Me.ServerInfoDataSet.tblBusUnit)
Errhand:
        If Err.Number = 0 Or Err.Number = 20 Then
            Resume Next
        Else
            MsgBox(Err.Number & " " & Err.Description)
            Exit Sub
        End If
    End Sub

    Private Sub cmdReport_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdReport.Click
        On Error GoTo Errhand

        Dim strsql As String
        Dim cn As New SqlConnection
        Dim cmd As SqlCommand
        Dim strconnect As String
        Dim fldCount As Integer
        Dim recCount As Long
        Dim recArray As Object

        Dim iCol As Integer
        Dim iRow As Integer
        Dim xlApp As Object
        Dim xlWb As Object
        Dim xlWs As Object
        Dim intselected As Integer

        intselected = ComboBox1.SelectedValue

        strconnect = "Data Source=VTG002971;Initial Catalog=ServerInfo;Integrated Security=SSPI;"
        strsql = "SELECT tblCIDetails.DeviceID, tblCIDetails.Asset_Number, tblDevTypes.DevTypeDesc, tblCIStatus.CI_Status, tblBusUnit.BusUnit, tblEstablishment.EstablishmentName, tblBuilding.BuildingName, tblOfficeNames.OfficeName, tblDomain.DomainDesc " & _
        "FROM tblCIStatus RIGHT JOIN (tblBusUnit RIGHT JOIN (((tblDevTypes RIGHT JOIN (tblOfficeNames RIGHT JOIN (tblCIDetails LEFT JOIN tblBuilding ON tblCIDetails.Building = tblBuilding.BuildingID) ON tblOfficeNames.OfficeID = tblCIDetails.Office) ON tblDevTypes.DevTypeID = tblCIDetails.Device_Type) LEFT JOIN tblDomain ON tblCIDetails.Domain = tblDomain.DomID) LEFT JOIN tblEstablishment " & _
        "ON tblCIDetails.Establishment = tblEstablishment.EstablishmentID) ON tblBusUnit.BUID = tblCIDetails.Business_Unit) ON tblCIStatus.Status_ID = tblCIDetails.Device_Status " & _
        "Where tblCIDetails.Business_Unit = " & intselected & ";"

        cn = New SqlConnection(strconnect)
        cmd = New SqlCommand(strsql)

        cmd.Connection = cn
        cmd.Connection.Open()

        Dim myData As SqlDataReader = cmd.ExecuteReader()

        xlApp = CreateObject("Excel.Application")
        xlWb = xlApp.Workbooks.Add
        xlWs = xlWb.Worksheets("Sheet1")

        xlApp.Visible = True
        xlApp.UserControl = True

        ' Copy field names to the first row of the worksheet
        fldCount = myData.FieldCount
        For iCol = 1 To fldCount
            xlWs.Cells(1, iCol).Value = myData.GetName(iCol - 1)
        Next

        ' Check version of Excel
        If Val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
            'EXCEL 2000,2002,2003, or 2007: Use CopyFromRecordset

            ' Copy the recordset to the worksheet, starting in cell A2
            xlWs.Cells(2, 1).CopyFromRecordset(myData)
            'Note: CopyFromRecordset will fail if the recordset
            'contains an OLE object field or array data such
            'as hierarchical recordsets

        Else
            'EXCEL 97 or earlier: Use GetRows then copy array to Excel

            ' Copy recordset to an array
            recArray = myData.GetRows
            'Note: GetRows returns a 0-based array where the first
            'dimension contains fields and the second dimension
            'contains records. We will transpose this array so that
            'the first dimension contains records, allowing the
            'data to appears properly when copied to Excel

            ' Determine number of records

            recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array


            ' Check the array for contents that are not valid when
            ' copying the array to an Excel worksheet
            For iCol = 0 To fldCount - 1
                For iRow = 0 To recCount - 1
                    'Take care of Date fields
                    If IsDate(recArray(iCol, iRow)) Then
                        recArray(iCol, iRow) = Format(recArray(iCol, iRow))
                        ' Take care of OLE object fields or array fields
                    ElseIf IsArray(recArray(iCol, iRow)) Then
                        recArray(iCol, iRow) = "Array Field"
                    End If
                Next iRow 'next record
            Next iCol 'next field

            ' Transpose and Copy the array to the worksheet,
            ' starting in cell A2
            xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
            TransposeDim(recArray)
                    End If

        ' Auto-fit the column widths and row heights
        xlApp.Selection.CurrentRegion.Columns.AutoFit()
        xlApp.Selection.CurrentRegion.Rows.AutoFit()

        ' Close ADO objects
        'rst.Close()
        'cnt.Close()
        'rst = Nothing
        'cnt = Nothing

        ' Release Excel references
        xlWs = Nothing
        xlWb = Nothing

        xlApp = Nothing


        cn.Close()
        myData.Close()

        myData = Nothing
        cn = Nothing


Errhand:
        If Err.Number = 0 Or Err.Number = 20 Then
            Resume Next
        Else
            MsgBox(Err.Number & " " & Err.Description)
            Exit Sub
        End If
    End Sub