CODEWITHSUNDEEP
excelvb.net
Rwolf27
Rwolf27

Reputation: 19

Write Datatable to a Excel file

I'm trying to copy a DataTable with data from a Mysql Table to a Excel file just that simple. But The code that I have creates and fills the data just as it should.

But I'd like to make this code just find the file and update/insert the data in there without the need of opening it.

Another thing, this process is painfully slow, is there a problem with the code ? Or its just as it is ?

The code is:

Dim dts As New DataTable
    Dim sql = "SELECT referencia, descricao, notas, tipo, custo, eqs, sac, preco_minimo, percent_pvp, margem_eqs, margem_sac, margem_minimo FROM produtos"

    Using conn As New MySqlConnection(ConStrMySql),
        cmd As New MySqlCommand(sql, conn)
        conn.Open()
        Using reader = cmd.ExecuteReader
            dts.Load(reader)
        End Using
    End Using

    Dim oXL As Excel.Application
    Dim oWB As Excel.Workbook
    Dim oSheet As Excel.Worksheet
    Dim oRange As Excel.Range

    oXL = New Excel.Application
    oXL.Visible = True
    oXL.DisplayAlerts = False

    oWB = oXL.Workbooks.Add

    oSheet = DirectCast(oWB.ActiveSheet, Excel.Worksheet)
    oSheet.Name = "Produtos"

    Dim dt As Data.DataTable = dts

    Dim rowCount As Integer = 1
    For Each dr As DataRow In dt.Rows
        rowCount += 1
        For i As Integer = 1 To dt.Columns.Count

            If rowCount = 2 Then
                Dim t = i - 1
                oSheet.Cells(1, i) = dt.Columns(t).ColumnName
            End If
            Dim j = i - 1
            oSheet.Cells(rowCount, i) = dr.Item(j).ToString
        Next
    Next

    oRange = oSheet.Range(oSheet.Cells(1, 1),
              oSheet.Cells(rowCount, dt.Columns.Count))
    oRange.EntireColumn.AutoFit()

    oSheet = Nothing
    oRange = Nothing
    oWB.SaveAs("test.xlsx")
    oWB.Close()
    oWB = Nothing
    oXL.Quit()

    GC.WaitForPendingFinalizers()
    GC.Collect()
    GC.WaitForPendingFinalizers()
    GC.Collect()

I've search a little for other ways of filling a file but i only found one that really worked and it was like this:

Using csv As New System.IO.StreamWriter("17 - tic\BD2021-UPDATE.xlsx")
        csv.WriteLine(String.Format("{0};{1};{2}", Data1, Data2, Data3))
    End Using

But this again creates a new file and i'd like to use an existing one:

Again the problem is: I have a code that works but i cant adapt it to use an existing file without creating a new one each time I call the Sub. And if my code as some problem with its performance.

Thanks

Upvotes: 0

Views: 939

Answers (1)

G3nt_M3caj
G3nt_M3caj

Reputation: 2705

Consider this helper Module as an alternative to save a Dataset in a Excel file. You need to have installed on machine/PC Microsoft.Jet.OLEDB.4.0 Excel 8.0 or 12. (If you are working with those files it presumes is installed). As you see the usage is simple:

Use the following Sub: ExportDataSetToExcel pas to it the Dataset you need to save and the path as String of file. If you want to make changes in your Excel doesn’t use the opened Excel file but just make changes in your Dataset then when you are done you can save the final content as a Excel file (with changes as well)

Module XlsHelper

    Event OnTotalRowsDetected(RowCount As Integer)
    Event OnRowExported(RowIndex As Integer)

    Const CON_STRING As String = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source='{0}'; Extended Properties='Excel 8.0;HDR=YES'"

    Function GetConnectionString(fileName As String, mode As String) As String
        Dim imex As String = CType(IIf(mode.ToLower = "write", "2", "1"), String)
        Return String.Format(CON_STRING, fileName, mode, imex)
    End Function

    Private Structure ExcelDataTypes
        Public Const NUMBER As String = "NUMBER"
        Public Const DATETIME As String = "DATETIME"
        Public Const TEXT As String = "TEXT"
    End Structure

    Private Structure NETDataTypes
        Public Const _Short As String = "Int16"
        Public Const _Int As String = "Int32"
        Public Const _Long As String = "Int64"
        Public Const _String As String = "String"
        Public Const _Date As String = "DateTime"
        Public Const _Bool As String = "Boolean"
        Public Const _Decimal As String = "Decimal"
        Public Const _Double As String = "Double"
        Public Const _Float As String = "Float"
    End Structure


    Sub ExportDataSetToExcel(ByVal dataSet As DataSet, filePath As String)

        Dim result() As Byte = Nothing

        Try

            Dim fileTemp As String = My.Computer.FileSystem.GetTempFileName
            If IsNothing(fileTemp) OrElse fileTemp.Length = 0 Then
                Throw New Exception("Connot write on temp folder. Check folder permissions")
            End If

            fileTemp &= ".xls"

            If dataSet IsNot Nothing AndAlso dataSet.Tables.Count > 0 Then
                Dim sConn As String = GetConnectionString(fileTemp, "Write")

                Using connection As OleDbConnection = New OleDbConnection(sConn)

                    connection.Open()

                    For Each dt As DataTable In dataSet.Tables

                        Dim strCreateTableStruct As String = BuildCreateTableCommand(dt)

                        If String.IsNullOrEmpty(strCreateTableStruct) Then Return

                        Using command As OleDbCommand = New OleDbCommand(strCreateTableStruct, connection)
                            command.ExecuteNonQuery()
                            Dim totRows As Integer = dt.Rows.Count - 1

                            RaiseEvent OnTotalRowsDetected(totRows)

                            For rowIndex As Integer = 0 To dt.Rows.Count - 1
                                Using command1 As OleDbCommand = New OleDbCommand(BuildInsertCommand(dt, rowIndex), connection)
                                    command1.ExecuteNonQuery()
                                End Using
                                RaiseEvent OnRowExported(rowIndex)
                            Next
                        End Using

                    Next

                End Using

            End If


            If IO.File.Exists(fileTemp) Then
                result = IO.File.ReadAllBytes(fileTemp)
                IO.File.Delete(fileTemp)
            End If

            If result IsNot Nothing AndAlso result.Length > 0 Then
                Using Fs As FileStream = New FileStream(filePath, FileMode.OpenOrCreate)
                    Fs.Write(result, 0, result.Length)
                End Using
            End If

        Catch eX As Exception
            MsgBox(eX.ToString)

        End Try





    End Sub

    Private Function BuildCreateTableCommand(ByVal dataTable As DataTable) As String
        Dim sb As StringBuilder = New StringBuilder()
        Dim dataTypeList As Dictionary(Of String, String) = BuildExcelDataTypes()
        If dataTable.Columns.Count <= 0 Then Return Nothing
        sb.AppendFormat("CREATE TABLE [{0}] (", BuildExcelSheetName(dataTable))

        For Each col As DataColumn In dataTable.Columns
            Dim type As String = ExcelDataTypes.TEXT

            If dataTypeList.ContainsKey(col.DataType.Name.ToString().ToLower()) Then
                type = dataTypeList(col.DataType.Name.ToString().ToLower())
            End If

            sb.AppendFormat("[{0}] {1},", col.Caption.Replace(" "c, "_"c), type)
        Next

        sb = sb.Replace(","c, ")"c, sb.ToString().LastIndexOf(","c), 1)
        Return sb.ToString()
    End Function

    Private Function BuildInsertCommand(ByVal dataTable As DataTable, ByVal rowIndex As Integer) As String
        Dim sb As StringBuilder = New StringBuilder()
        sb.AppendFormat("INSERT INTO [{0}$](", BuildExcelSheetName(dataTable))

        For Each col As DataColumn In dataTable.Columns
            sb.AppendFormat("[{0}],", col.Caption.Replace(" "c, "_"c))
        Next

        sb = sb.Replace(","c, ")"c, sb.ToString().LastIndexOf(","c), 1)
        sb.Append("VALUES (")

        For Each col As DataColumn In dataTable.Columns
            Dim type As String = col.DataType.ToString()
            Dim strToInsert As String = dataTable.Rows(rowIndex)(col).ToString().Replace("'", "''")
            sb.AppendFormat("'{0}',", strToInsert)
        Next

        sb = sb.Replace(","c, ")"c, sb.ToString().LastIndexOf(","c), 1)
        Return sb.ToString()
    End Function

    Private Function BuildExcelSheetName(ByVal dataTable As DataTable) As String
        Dim retVal As String = dataTable.TableName
        If dataTable.ExtendedProperties.ContainsKey("test") Then retVal = dataTable.ExtendedProperties("test").ToString()
        Return retVal.Replace(" "c, "_"c)
    End Function

    Private Function BuildExcelDataTypes() As Dictionary(Of String, String)
        Dim dataTypeLookUp As Dictionary(Of String, String) = New Dictionary(Of String, String) From {
                {NETDataTypes._Short, ExcelDataTypes.NUMBER},
                {NETDataTypes._Int, ExcelDataTypes.NUMBER},
                {NETDataTypes._Long, ExcelDataTypes.NUMBER},
                {NETDataTypes._String, ExcelDataTypes.TEXT},
                {NETDataTypes._Date, ExcelDataTypes.DATETIME},
                {NETDataTypes._Bool, ExcelDataTypes.TEXT},
                {NETDataTypes._Decimal, ExcelDataTypes.NUMBER},
                {NETDataTypes._Double, ExcelDataTypes.NUMBER},
                {NETDataTypes._Float, ExcelDataTypes.NUMBER}
            }
        Return dataTypeLookUp

    End Function

End Module

Usage:

ExportDataSetToExcel(dts, "C\Somewhere\17 - tic\BD2021-UPDATE.xlsx")

Upvotes: 1

Related Questions