导出excel功能

 ''' <summary>
    ''' 导出excel功能
    ''' </summary>
    ''' <param name="Table"></param>
    ''' <param name="DefFileName"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Shared Function DtToXls(ByVal Table As DataTable, ByVal DefFileName As String)
        Dim MyOleDbCn As New System.Data.OleDb.OleDbConnection
        Dim MyOleDbCmd As New System.Data.OleDb.OleDbCommand
        Dim MyTable As New DataTable
        Dim intRowsCnt, intColsCnt As Integer
        Dim strSql As String, strFlName As String
        Dim Fso As New System.Object
        If Table Is Nothing Then
            MessageBox.Show("未取得數據,無法導出", "導出錯誤", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Exit Function
        End If
        MyTable = Table
        If MyTable.Rows.Count = 0 Then
            MessageBox.Show("未取得數據,無法導出", "導出錯誤", MessageBoxButtons.OK, MessageBoxIcon.Error)
            Exit Function
        End If
        Dim FileName As String = ""
        Dim SaveFileDialog As New SaveFileDialog
        SaveFileDialog.InitialDirectory = My.Computer.FileSystem.SpecialDirectories.MyDocuments
        SaveFileDialog.Title = "保存為"
        SaveFileDialog.Filter = ".xls|*.xls"
        SaveFileDialog.FileName = DefFileName
        If (SaveFileDialog.ShowDialog() = System.Windows.Forms.DialogResult.OK) Then
            FileName = SaveFileDialog.FileName
            '   TODO:   在此加入開啟檔案的程式碼。  
        End If
        If FileName = "" Then Exit Function
        strFlName = FileName
        If Dir(FileName) <> "" Then
            Kill(FileName)
        End If
        Try
            Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor

            MyOleDbCn.ConnectionString = "Provider=Microsoft.Jet.OleDb.4.0;Data Source=" & strFlName & ";Extended properties=Excel 8.0;"
            MyOleDbCn.Open()
            MyOleDbCmd.Connection = MyOleDbCn
            MyOleDbCmd.CommandType = CommandType.Text

            '第一行插入列标题  
            strSql = "CREATE   TABLE   " & DefFileName & "("
            For intColsCnt = 0 To MyTable.Columns.Count - 1
                If intColsCnt <> MyTable.Columns.Count - 1 Then
                    strSql = strSql & ChangeChar(MyTable.Columns(intColsCnt).Caption) & "   text,"
                Else
                    strSql = strSql & ChangeChar(MyTable.Columns(intColsCnt).Caption) & "   text)"
                End If
            Next
            MyOleDbCmd.CommandText = strSql
            MyOleDbCmd.ExecuteNonQuery()

            '插入各行  
            For intRowsCnt = 0 To MyTable.Rows.Count - 1
                strSql = "INSERT   INTO   " & DefFileName & "   VALUES('"
                For intColsCnt = 0 To MyTable.Columns.Count - 1
                    If intColsCnt <> MyTable.Columns.Count - 1 Then
                        strSql = strSql & ChangeChar(MyTable.Rows(intRowsCnt).Item(intColsCnt)) & "','"
                    Else
                        strSql = strSql & ChangeChar(MyTable.Rows(intRowsCnt).Item(intColsCnt)) & "')"
                    End If
                Next
                MyOleDbCmd.CommandText = strSql
                MyOleDbCmd.ExecuteNonQuery()
            Next
            MessageBox.Show("数据已经成功导入EXCEL文件" & strFlName, "数据导出", MessageBoxButtons.OK, MessageBoxIcon.Information)
        Catch ErrCode As Exception
            MsgBox("错误信息:" & ErrCode.Message & vbCrLf & vbCrLf & _
            "引发事件:" & ErrCode.TargetSite.ToString, MsgBoxStyle.OkOnly + MsgBoxStyle.Information, "错误来源:" & ErrCode.Source)
            Exit Function
        Finally
            MyOleDbCmd.Dispose()
            MyOleDbCn.Close()
            MyOleDbCn.Dispose()
            'Me.Cursor.Current   =   System.Windows.Forms.Cursors.Default  
        End Try

    End Function

    Shared Function ChangeChar(ByVal Sqlchar) As String
        If Convert.IsDBNull(Sqlchar) Then
            ChangeChar = "   "
            Exit Function
        End If
        Dim tStr As String
        tStr = Replace(Sqlchar, "'", Chr(39) + Chr(39))
        tStr = Replace(tStr, "|", "_")
        ChangeChar = tStr
    End Function
    '导出excel
    Shared Sub ExportExcel(ByVal mygrid As DataGridView, ByVal xlsFileName As String)
        Dim savefiledialog1 As New SaveFileDialog
        Dim FileName As String = ""
        With savefiledialog1
            .OverwritePrompt = True
            .Title = "保存文件:"
            .InitialDirectory = Application.StartupPath
            .Filter = ".xls|*.xls"
            .FileName = xlsFileName
            If .ShowDialog() = DialogResult.OK Then
                FileName = .FileName
                '   TODO:   在此加入開啟檔案的程式碼。  
            End If
        End With
        Dim appexcel As New Excel.Application
        Dim wks As Excel.Workbooks = appexcel.Workbooks
        wks.Add(True)
        Dim sht As Excel.Worksheet = appexcel.ActiveSheet
        '填入网格标题
        Dim i As Integer = 0
        For Each mcol As DataGridViewColumn In mygrid.Columns
            If mcol.Visible Then
                i = i + 1
                sht.Cells(1, i) = mcol.HeaderText
            End If
        Next
        '填入网格数据内容()
        Dim m As Integer
        For j As Long = 0 To mygrid.RowCount - 1
            If mygrid.Rows(j).IsNewRow = False Then
                m = 0
                For k As Integer = 0 To mygrid.Columns.Count - 1
                    If mygrid.Columns(k).Visible = True Then
                        m = m + 1
                        sht.Cells(2 + j, m) = "'" & mygrid.Rows(j).Cells(k).Value
                    End If
                Next
            End If
        Next
        wks(1).SaveAs(xlsFileName)
        wks.Close()
        appexcel.Quit()
        System.Runtime.InteropServices.Marshal.ReleaseComObject(appexcel)
        appexcel = Nothing
        MsgBox("导出成功" & xlsFileName, MsgBoxStyle.OkOnly, "信息提示:")
    End Sub

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值