exportar a excel

[ultimateZERO]

Hola, estuve investigando y supongo que a la primera forma que dices (con select e insert) es como sigue.

Solo cambie un par de cosas que me daban error:

1 – cambie los &= por += (no se por que pero aveces me daban error y aveces no)
2 – cambie:
Dim da As New OleDbDataAdapter("Select * From [" + SheetName + "$]", conn)
Por
Dim da As New OleDbDataAdapter("Select * From [" + SheetName + "]", conn)
3 – cambie:
da.InsertCommand = New OleDbCommand("INSERT INTO [" + SheetName + "$] " + Inse……
por
da.InsertCommand = New OleDbCommand("INSERT INTO [" + SheetName + "] " + Inse……

Bueno aquí esta el resultado y si me funciono así que aquí esta mi parte y espero les sirva (el código original no recuerdo de donde lo saque, si lo encuentro de nuevo les digo, de todas formas es fácil de encontrar fue de los primeros resultados de google)

Código:

Imports System.Data.OleDb

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim ds As DataSet = New DataSet("jose")
        ds.Tables.Add("t1")
        ds.Tables("t1").Columns.Add("c1")
        ds.Tables("t1").Columns.Add("c2")
        ds.Tables("t1").Columns.Add("c3")

        Dim r As DataRow

        r = ds.Tables("t1").NewRow
        r.Item(0) = "aa"
        r.Item(1) = "bb"
        r.Item(2) = "cc"
        ds.Tables("t1").Rows.Add(r)

        r = ds.Tables("t1").NewRow
        r.Item(0) = "11"
        r.Item(1) = "22"
        r.Item(2) = "33"
        ds.Tables("t1").Rows.Add(r)

        ExportExcel("C:\a.xls", ds)
    End Sub

    Sub ExportExcel(ByVal DestinationXLSFile As String, ByVal SourceDS As DataSet)
        'reference site http://support.microsoft.com/default.aspx?scid=kb;EN-US;316934
        'Delete the old file

        If Dir(DestinationXLSFile) <> "" Then Kill(DestinationXLSFile)

        'Create the new File
        Dim Conn1 As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + DestinationXLSFile + ";Extended Properties=""Excel 8.0;HDR=YES"""

        Dim conn As New OleDbConnection
        conn.ConnectionString = Conn1
        conn.Open()
        Dim cmd1 As New OleDbCommand
        cmd1.Connection = conn

        'Create The Sheets
        Dim SheetName As String
        Dim CreateTablestring As String = ""
        Dim InsertString1 As String = ""
        Dim InsertString2 As String = ""
        'Dim UpdateString As String = ""
        Dim ExcelDS As New DataSet
        Dim DataType As String
        Dim ColName As String = ""
        Dim dr, dr2 As DataRow

        For i As Integer = 0 To SourceDS.Tables.Count - 1
            SheetName = SourceDS.Tables(i).TableName
            CreateTablestring = " ("
            InsertString1 = "("
            InsertString2 = "("
            'UpdateString = ""

            For C As Integer = 0 To SourceDS.Tables(i).Columns.Count - 1
                ColName = SourceDS.Tables(i).Columns(C).ColumnName
                'Createtablestring
                DataType = SourceDS.Tables(i).Columns(C).DataType.ToString

                Select Case DataType
                    Case "System.String"
                        CreateTablestring += ColName + " char(255)"
                    Case "System.Int32"
                        CreateTablestring += ColName + " int"
                    Case Else
                        'todo
                        CreateTablestring += ColName + " char(255)"
                End Select

                InsertString1 += ColName
                InsertString2 += "?"
                'UpdateString += ColName + " = ?"

                If C <> SourceDS.Tables(i).Columns.Count - 1 Then
                    CreateTablestring += ", "
                    InsertString1 += ", "
                    InsertString2 += ", "
                    'UpdateString += ", "
                Else
                    CreateTablestring += ")"
                    InsertString1 += ")"
                    InsertString2 += ")"
                End If
            Next

            cmd1.CommandText = "CREATE TABLE " + SheetName + CreateTablestring
            cmd1.ExecuteNonQuery()

            Dim da As New OleDbDataAdapter("Select * From [" + SheetName + "]", conn)
            da.Fill(ExcelDS, SheetName)
            'Only need the INSERT command as deleted records will be ignored
            da.InsertCommand = New OleDbCommand("INSERT INTO [" + SheetName + "] " + InsertString1 + " VALUES " + InsertString2, conn)
            'da.UpdateCommand = New OleDbCommand("UPDATE [" + SheetName + "$] SET " + UpdateString, conn)

            For C As Integer = 0 To SourceDS.Tables(i).Columns.Count - 1
                ColName = SourceDS.Tables(i).Columns(C).ColumnName
                DataType = SourceDS.Tables(i).Columns(C).DataType.ToString

                Select Case DataType
                    Case "System.String"
                        da.InsertCommand.Parameters.Add("@" + ColName, OleDbType.VarChar, 255, ColName)
                    Case "System.Int32"
                        da.InsertCommand.Parameters.Add("@" + ColName, OleDbType.Integer, 7, ColName)
                    Case Else
                        'todo
                        da.InsertCommand.Parameters.Add("@" + ColName, OleDbType.VarChar, 255, ColName)
                End Select
                'da.UpdateCommand.Parameters.Add("@" + ColName, OleDbType.VarChar, 255, ColName)

            Next

            For Each dr In SourceDS.Tables(i).Rows
                'todo why does this not work
                'ExcelDS.Tables(i).ImportRow(dr)
                'Replace with this

                dr2 = ExcelDS.Tables(i).NewRow
                For it As Integer = 0 To ExcelDS.Tables(i).Columns.Count - 1
                    dr2.Item(it) = dr.Item(it)
                Next

                ExcelDS.Tables(i).Rows.Add(dr2)
            Next

            da.Update(ExcelDS, SheetName)
        Next

        conn.Close()
    End Sub

End Class