Export Data from SQL Database into Excel Spreadsheet

[Polariss]

I just want to say thanks to all of you guys out there. All of you guys have assisted me at one time or another especially doing searches. The only way I know how to give back is to post some code.

This code basically builds an sql query from some controls, and then pulls the data from a sql database and transports it to excel. If you have any questions feel free to post.

Begin the SELECT statement

Public Function Begin_Query()
        Dim selectWhat As String
        Dim i As Integer
        Dim k As Integer
        Dim maxValue As Integer
        maxValue = chkFields.Items.Count - 1
        Dim indexvalue(maxValue) As String
        Dim counter As Integer
        For i = 0 To maxValue
            If chkFields.Items(i).Selected Then
                counter = counter + 1
                indexvalue(counter - 1) = chkFields.Items(i).Value
            End If
        Next
        For k = 0 To counter - 1
            If k = counter - 1 Then
                selectWhat = selectWhat & indexvalue(k)
            Else
                selectWhat = selectWhat & indexvalue(k) & ", "
            End If
        Next
        Return selectWhat
    End Function

Now the conditions associated with the query

Public Function Conditional_Query()
        Dim conditions As String
        Dim fieldname As String
        Dim conditiontype As String
        Dim expression As String
        fieldname = cmbFields.SelectedItem.Value
        conditiontype = cmbCondition.SelectedItem.Value
        expression = txtCondition.Text
        If fieldname = "NONE" Or conditiontype = "NONE" Then
            Return conditions
        ElseIf conditiontype = "LIKE" Then
            conditions = "WHERE (" & fieldname & " " & conditiontype & " '%" & txtCondition.Text & "%')"
        Else
            conditions = "WHERE (" & fieldname & " " & conditiontype & " '" & txtCondition.Text & "')"
        End If
        Return conditions
 
    End Function

Now end the query

Public Function Orderby_Query()
        Dim sorting As String
        Dim sortby As String
        sortby = cmbSort.SelectedItem.Value
        If sortby = "NONE" Then
 
        Else
            sorting = " ORDER BY " & sortby & ""
        End If
        Return sorting
    End Function

Now the export function.. Note: I did do a search on Excel and found the way to pull the stuff out so I dont get credit for that part of the code. I cannot remember who posted it but they did an excellent job.

Public Function Export_Excel(ByVal Query As String)
 
        Dim sqlconn As SqlConnection = New SqlConnection
        Dim strConn As String
        strConn = "Server=SERVERNAME;Database=dbname;User ID=USER;Password=PASSWORD"
        sqlconn.ConnectionString = strConn
        sqlconn.Open()
        'File control.  Have to delete the file if it already exists otherwise create it.  Its easier just to delete the file rather than check to see if its already there.
        Dim dir As Directory
        Dim dirfile As File
        Dim pathname As String
        Dim title As String
        If txtFilename.Text = "" Then
            title = "cl"
        Else
            title = txtFilename.Text
        End If
        pathname = "C:\Inetpub\wwwroot\Workorders\" & title & ".xls"
        Dim filepath As String
        Dim i As Integer
        filepath = Server.MapPath(Request.ApplicationPath) & "\" & title & ".xls"
        dirfile.Delete(pathname)
        'Bind the dataset to the results returned from the DataAdapter.
        Dim sAdapter As New SqlDataAdapter(Query, sqlconn)
        Dim ds As New DataSet
        sAdapter.Fill(ds, "cl")
 
        'Start the Excel Sheet Declarations and initiate the spreadsheet
        Dim xl As Excel.Application
        Dim oBook As Excel.Workbook
        Dim oSheet As Excel.Worksheet
        xl = CreateObject("Excel.Application")
        oBook = xl.Workbooks.Add
        oBook.Worksheets.Add()
        oSheet = CType(oBook.Worksheets(1), Excel.Worksheet)
        oSheet.Name = title
        oSheet.Range("A:Z").ColumnWidth = 30
        xl.Visible = True
 
        'Start filling in data from database.  Cannot take credit for this part. 
        Dim iColumn, iRow As Integer
        Dim iColumnMax, iRowMax As Integer
        iRowMax = ds.Tables(0).Rows.Count - 1
        iColumnMax = ds.Tables(0).Columns.Count - 1
        For iRow = 0 To iRowMax
            For iColumn = 0 To iColumnMax
                oSheet.Cells(iRow + 3, iColumn + 1) = ds.Tables(0).Rows(iRow).Item(iColumn)
            Next
        Next
'Thank you vbforums for that little bit of code.
        'Start looping through the items that are selected.  If they are selected add them to a different array with a different index.
        Dim maxValue As Integer
 
        maxValue = chkFields.Items.Count - 1
        Dim counters As Integer
        Dim itemtext(maxValue) As String
        Dim itemvalue(maxValue) As String
        For i = 0 To maxValue
            If chkFields.Items(i).Selected Then
                counters = counters + 1
                itemtext(counters - 1) = chkFields.Items(i).Text
                itemvalue(counters - 1) = chkFields.Items(i).Value
            End If
        Next
 
 
        'Customize the spreadsheet's cells
        Dim counter As Integer
        For counter = 0 To iColumnMax
            oSheet.Cells(2, counter + 1).Font.Bold = True
            oSheet.Cells(2, counter + 1).Font.Size = 14
            oSheet.Cells(2, counter + 1).Interior.Color = &H808080
            oSheet.Cells(2, counter + 1).Value = itemtext(counter)
        Next
 
        oSheet.Cells(1, 3).Value = title
 
        oSheet.Cells(1, 3).Font.Bold = True
        oSheet.Cells(1, 3).Font.Italic = True
        oSheet.Cells(1, 3).Font.Size = 14
        oSheet.Cells(1, 3).Interior.Color = &H808080
        oSheet.Cells(1, 1).Interior.Color = &H808080
        oSheet.Cells(1, 2).Interior.Color = &H808080
        oSheet.Columns.AutoFit()
        oSheet.Activate()
 
 
 
        'Save and display the object
        oSheet.SaveAs(filepath)
        Send_Mail(Query, title)
        xl.DisplayAlerts = True
        
        'Cleanhouse
        xl.Quit()
        ReleaseComObject(oSheet)
        ReleaseComObject(oBook)
        ReleaseComObject(xl)
 
        ds = Nothing
        xl = Nothing
        oBook = Nothing
        oSheet = Nothing
        System.GC.Collect()
 
        Response.Redirect(title & ".xls")
        sqlconn.Close()
 
    End Function

And the last function here is to send an email based on what you logged in as. This will also send you a hyperlink to the report that was generated.

Public Function Send_Mail(ByVal Query As String, ByVal title As String)
        Dim eaddress, aaddress As String
 
        eaddress = Session("Usernme")
        Select Case eaddress
            Case "name1"
                aaddress = "[email protected]"
            Case "name2"
                aaddress = "[email protected]"
            Case "name3"
                aaddress = "[email protected]"
            Case Else
                aaddress = "[email protected]"
        End Select
        Dim dayt, timed As String
        dayt = Now.Date
        timed = Now.TimeOfDay.ToString
        Dim message As String
        Dim email As New MailMessage
        SmtpMail.SmtpServer = "IP OR NAME OF SERVER"
        message = "A new report has been generated with the query being " & Query & ".  The report was ran " & dayt & " at " & timed & ".  You may find this report at the following location http://servername/direcname/" & title & ".xls."
        email.From = "[email protected]"
        email.To = aaddress
        email.Subject = "Report generated from table call log."
        email.Body = message
        SmtpMail.Send(email)
 
    End Function

NOTE: This code isnt finished by any means. This is a somewhat finished state. I know I need to clean it up a lot but I wanted to post while I was still tingling a little bit. The code has been tested and it works perfect for what my boss needs.