''' <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