<output id="os3gq"><ruby id="os3gq"></ruby></output>

    1. <mark id="os3gq"></mark>
    2. Access導出到Excel方法匯總-mabaor
      Access軟件網QQ交流學習群(群號碼198465573),歡迎您的加入!
      首頁 >技術文章> Access數據庫-模塊/函數/VBA


      Access導出到Excel方法匯總

      發表時間:2018/2/6 23:05:58 評論(4) 瀏覽(20731)  評論 | 加入收藏 | 復制
         
      摘 要:因為一個導出功能的需要,查閱了好多的案例,正好發現在OFFICE-中國有這樣一個很好的帖子,收藏下來,以供以后學習查閱,也供其它朋友收藏使用
      正 文:
      Access vba有各種方法可以導出到Excel,大致如下:

      方法 優點 缺點
      查詢導出 可以根據查詢設計(直觀) 格式固定
      ADO逐條遍歷 寫入位置可以靈活控制 速度較慢
      CopyFromRecordset 速度極快   格式固定
      Excel插入QueryTable 速度較快,可以匯總
      復制粘貼 標題、格式和子窗體一致 只能導出數據表顯示的子窗體數據
      1、利用查詢導出

      DoCmd.OutputTo acOutputQuery, "具體的查詢名稱", acFormatXLS, , True

      執行這條語句,即可把對應的查詢導出到Excel文件

      拓展:
      1)、當然,你也可以根據SQL語句自動創建查詢,再導出。
          CurrentDb.CreateQueryDef "新的查詢名稱", "SQL語句"  '創建查詢
      2)、然后,導出之后,你可以刪除掉這個查詢
          DoCmd.DeleteObject acQuery, "查詢名稱"              '刪除查詢
      3)、當然,你可以修改當前查詢的SQL語句之后,再導出

          Dim qdf As Object  'DAO.QueryDef
          Set qdf = CurrentDb.QueryDefs("查詢名稱")
          qdf.SQL = strSQL   '設置新的SQL語句



      2、ADO逐條遍歷
      這種方法是最傳統和最典型的方法,也是最靈活的。

      打開一個記錄集,然后遍歷數據對Excel操作即可。重點在操作Excel。


      							
          Dim rs As New ADODB.Recordset
          Dim xlApp As Object     'Excel.Application
          Dim xlBook As Object    'Excel.Workbook
          Dim xlSheet As Object   'Excel.Worksheet
          Set xlApp = CreateObject("Excel.Application")
          Set xlBook = xlApp.Workbooks.Add    '添加一個新的Book
          Set xlSheet = xlApp.ActiveSheet     '使用當前的Sheet
          Dim strSql As String
          Dim i As Long
          strSql="Select * from 表1 where ID<10"
          rs.Open strSql, CurrentProject.Connection, 1, 1
              Do While Not rs.EOF
                  xlSheet.Cells(2 + i,1)=rs("ID")   '從第2行開始寫數據
                  xlSheet.Cells(2 + i,2)=rs("FName")
                  rs.MoveNext
                  i=i+1
              Loop
          rs.Close
          xlApp.Visible=True
      
      

      3、CopyFromRecordset導出數據
      CopyFromRecordset是Excel vba的方法,可以快速把一個記錄集的數據填充到Excel單元格中。
      '標題:根據SQL語句,快速導出到Excel文件
      '作者:阿航
      
      '創建日期:2015-01-10
      '說明:
      '   - 會將SQL語句的字段名作為標題?梢杂肁s的方式設置對應字段的標題,如果是關鍵字,要加中括。
      '   - 示例:ExportToExcel "select FID as [ID], FText as 文本 from 表1"
      '更新日期:2015-09-05
      '   - 添加一個長度可變的參數,用于傳遞標題
      '   - 示例:ExportToExcel "select FID,FText from 表1","主鍵","文本"
      Public Function ExportToExcel(strSql As String, ParamArray VarExpr() As Variant) As Boolean
          Dim rs As Object        'DAO.Recordset(用ADO也行)
          Dim xlApp As Object     'Excel.Application
          Dim xlBook As Object    'Excel.Workbook
          Dim xlSheet As Object   'Excel.Worksheet
          Dim i As Integer
                
          '創建Excel文件
      On Error GoTo Err_Show
          Set xlApp = CreateObject("Excel.Application")
          Set xlBook = xlApp.Workbooks.Add    '添加一個新的Book
          Set xlSheet = xlApp.ActiveSheet     '使用當前的Sheet
                
          Set rs = CurrentDb.OpenRecordset(strSql)
          '先寫入標題(可以考慮用DAO的字段標題屬性 rs(i-1).Properties("Caption"))
      '    For i = 1 To rs.Fields.Count
      '        xlSheet.cells(1, i) = rs(i - 1).Name
      '    Next
          '更新部分(2015-09-05)長度可變的參數,相當于一個數組
          For i = 0 To UBound(VarExpr)
              xlSheet.cells(1, i + 1) = VarExpr(i)
          Next
                    
          '再寫入數據
          xlSheet.Range("A2").CopyFromRecordset rs
          rs.Close
                
          '調整列寬
          xlSheet.Columns.EntireColumn.AutoFit
          xlApp.Visible = True
          xlBook.Activate
          ExportToExcel = True
                
      Err_Exit:
          Set xlSheet = Nothing
          Set xlBook = Nothing
          Set xlApp = Nothing
          Set rs = Nothing
          Exit Function
      Err_Show:
          MsgBox "導出出錯,請重新嘗試" & vbCrLf & Err.Description, "導出出錯"
          On Error Resume Next
          '出錯則清掉文件,避免有多個Excel進程
          xlBook.Close False
          If xlApp.Workbooks.Count = 0 Then xlApp.Quit
          GoTo Err_Exit
      End Function


      4、Excel插入QueryTable
      QueryTable是Excel的一種表格對象,可以插入一個DAO記錄集
      '---用記錄填充Excel表格
      '輸入參數: RS,需要填充的記錄集
      '          InsertSheet, 需要填充的Excel工作表
      '          InsertSheet, 需要開始填充的單元格
      '返回參數, 填充完畢的range
      
      
      Public Function FillRS(ByRef rsInsert As DAO.Recordset, ByRef sheetInsert As Excel.Worksheet, rangeInsert As Excel.Range) As Excel.Range
          Dim qtTable As Excel.QueryTable
          Dim loListObject As Excel.ListObject
      
          '根據記錄集生成一個querytable
          rsInsert.MoveFirst
      
          Set qtTable = sheetInsert.QueryTables.Add(Connection:=rsInsert, Destination:=rangeInsert)
      
          With qtTable
              .FieldNames = True
              .AdjustColumnWidth = True
              .Refresh BackgroundQuery:=False
          End With
      ' 把QueryTable ListObject
          Set loListObject = sheetInsert.ListObjects.Add(xlSrcRange, qtTable.ResultRange, , xlYes)
      
          With loListObject
              .ShowTotals = True   '顯示匯總列
              .ShowAutoFilter = True
      
              '顯示匯總數據
              Dim fld As DAO.Field
              For Each fld In rsInsert.Fields
                  Select Case fld.Type
                      Case dbCurrency
                          '.ListColumns(fld.Name).TotalsCalculation = xlTotalsCalculationSum
                          .ListColumns(fld.Name).Range.NumberFormat = "#,##0.00;-#,##0.00"
      
                      Case dbDate
                          .ListColumns(fld.Name).Range.NumberFormat = "yyyy-mm-dd;@"
                  End Select
              Next
              '.TableStyle = "TableStyleMedium9"
      
              '.Range.AutoFormat xlRangeAutoFormatList1
              Set FillRS = .Range
              .Unlink
              .Unlist
          End With
      
          Set qtTable = Nothing
      End Function
      

      5、復制粘貼的方法,快速導出數據
      在某次發現了,可以手動復制子窗體上的數據,然后粘貼到Excel中。于是就嘗試用這代碼實現這個功能
       Me.子窗體控件名.SetFocus                    '子窗體控件獲得焦點
          DoCmd.RunCommand acCmdSelectAllRecords      '選中所有記錄
          DoCmd.RunCommand acCmdCopy                  '復制
          DoEvents
      
          Dim Obj As Object
          Set Obj = CreateObject("excel.application") '創建Excel對象
          Obj.workbooks.Add                           '新建工作簿
          Obj.Visible = True                          '設為可見
          SendKeys "^v", True                         '粘貼數據

      Access軟件網交流QQ群(群號:198465573)
       
       相關文章
      【access源碼示例】導入導出系列--Excel固定格式的訂單導...  【紅塵如煙  2010/12/24】
      access vba之數據導出excel和html  【麥田  2012/8/15】
      【Access小品】通用選擇字段導出示例  【煮江品茶  2013/7/19】
      新建查詢批量導出excel  【大海  2017/12/9】
      批量導出excel有關的注意事項  【仙來  2017/12/31】
       
       訪客評論
      2019/5/30my way
      過份的要求希望附上實例,非常感謝

      2018/11/22崔宇
      CopyFromRecordset學習了

      2018/2/8吳先明
      謝謝總結,收藏!

      2018/2/7xiaowuo
      感謝總結經驗,收藏啦

      總記錄:4篇  頁次:1/1 9 1 :
       
       發表評論
      評論內容 (必填)

      常見問答
      技術分類
      相關資源
      文章搜索
      關于作者

      mabaor

      文章分類

      文章存檔

      友情鏈接
       
         
      湖北11选5