Public Function ExporToExcel(strOpen As String)

'*********************************************************

'* 名稱：ExporToExcel

'* 功能：導出數據到EXCEL

'* 用法：ExporToExcel(sql查詢字符串)

'*********************************************************

Dim Rs_Data As New ADODB.Recordset

Dim Irowcount As Integer

Dim Icolcount As Integer

StbInfo ("正在聯系EXCEL,準備創建并定義工作表...")

Dim xlApp As New Excel.Application

Dim xlBook As Excel.Workbook

Dim xlSheet As Excel.Worksheet

Dim xlQuery As Excel.QueryTable

On Error Resume Next

With Rs_Data

If .State = adStateOpen Then

.Close

End If

.ActiveConnection = cn

.CursorLocation = adUseClient

.CursorType = adOpenStatic

.LockType = adLockReadOnly

.Source = strOpen

.Open

End With

StbInfo ("正在向excel的工作表中添加數據...請稍候...")

With Rs_Data

If .RecordCount < 1 Then

MsgBox "沒有記錄可以導出，請確認數據源記錄是否為空!", vbInformation, "錯誤："

Exit Function

End If

'記錄總數

Irowcount = .RecordCount

'字段總數

Icolcount = .Fields.Count

End With

Set xlApp = CreateObject("Excel.Application")

Set xlBook = Nothing

Set xlSheet = Nothing

Set xlBook = xlApp.Workbooks().Add

Set xlSheet = xlBook.Worksheets("sheet1")

xlApp.Visible = True

'添加查詢語句，導入EXCEL數據

Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a2"))

With xlQuery

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.BackgroundQuery = True

.RefreshStyle = xlInsertDeleteCells

.SavePassword = True

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.PreserveColumnInfo = True

End With

xlQuery.FieldNames = True '顯示字段名

xlQuery.Refresh

With xlSheet

.Range(.Cells(1, 1), .Cells(1, Icolcount + 1)).Font.Name = "微軟雅黑"

.Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Size = 14

.Range(.Cells(1, 2), .Cells(1, Icolcount)).Font.Bold = True

'.Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount + 1)).Font.Size = 10

.Columns.Width = 300

'標題字體加粗

.Range(.Cells(2, 1), .Cells(Irowcount + 2, Icolcount)).Borders.LineStyle = xlContinuous

.Range(.Cells(2, 1), .Cells(Irowcount + 2, Icolcount)).Font.Name = "微軟雅黑"

.Range(.Cells(2, 1), .Cells(Irowcount + 2, Icolcount)).Font.Size = 9

'.Range(.Cells(2, 1), .Cells(Irowcount + 2, Icolcount)).Font.Color = vbRed

'設表格邊框樣式

End With

If CirPickPlt = False Then

xlSheet.Cells(1, 1) = XlsTitle??'自定義表頭

End If

xlApp.Application.Visible = True

If Prt = True Then xlApp.Worksheets.PrintPreview

xlApp.DisplayAlerts = False

Set xlApp = Nothing??'"交還控制給Excel

Set xlBook = Nothing

Set xlSheet = Nothing

xlApp.Quit

End Function

總結

以上是生活随笔為你收集整理的access导出MySQL表格_如何将Access数据库里的表内容导出到Excel的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。