将过滤的访问数据表导出到Excel电子表格-无截断

我一直在从事一个项目，我的客户希望做的一件事就是拥有一个格式精美的excel手动复制的子表单数据表的重复电子表格，其中导出的所有记录都包括备忘录。

起初我很挣扎，但是想出了以下代码，我希望与他人分享，因为我知道人们对于数据库知识和项目将需要它。

目前，出口面临的主要问题之一是“

备注字段的截断 ”从访问到excel。

但是，我的代码不会遇到这种情况，因为创建了excel应用程序对象的实例，并且数据表上的数据基本上已复制并粘贴到电子表格中。

我已经试验了500个单词（在备注字段中大约有2000个字符），并且所有导出的内容都完整无缺。

希望您会喜欢使用我的代码。

注意：我曾尝试使用“ DoCmd.TransferSpreadsheet”和“ DoCmd.OutputTo”，但对我来说却是一场噩梦。

但是有不同的经验，人们可能会解决这两个过程，但对我而言效果不佳。

编程愉快！

干杯!

杰瑞

Option Compare Database
'*******************************************
'Author: Jerry Maiapu
'email: jmaiapu@atlantisgoose.com
'Please do not remove the author's name
'This is code basically copies filtered records from a subform dataseet to an excel spreadsheet
'There are a few basic formating applied once exported to Excel
'Decided to share this as I have seen many people asked questions in reagrds to access to excel data export
'Note that with this code, memo fields will not be trunculated..
Option Explicit
Private Sub export _Click()
Me. usn_subform .SetFocus                'line 1: Selects the subform
Me. usn_subform ! Item .SetFocus           'Line 2: sets the focus in the first field/record in the subform
DoCmd.RunCommand acCmdSelectAllRecords  'Select all the records-ie including filtred records
DoCmd.RunCommand acCmdCopy              'Copy the selected record
Dim xlapp As Object 
Set xlapp = CreateObject("Excel.Application") 'create an excel application object
With xlapp
.Workbooks.Add 'add new workbook in the excel
.ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False ' Line 10
'Line 10: paste the copied records,not as a link please
.Cells.Select 'now select all cells in excel
.Cells.Entirecolumn.WrapText = True 'wrap text in all cells
.columns("N:N").ColumnWidth = 60
.columns("M:M").ColumnWidth = 90
.columns("O:O").ColumnWidth = 90
.columns("A:L").ColumnWidth = 18
.columns("A:A").ColumnWidth = 8
.columns("G:I").ColumnWidth = 10
.columns("R:R").ColumnWidth = 13
'the above does this: More spaces needed in columns N&M  while less space needed in A & G to I 
.Cells.rows.AutoFit 'applying auto fit feature for rows
.selection.AutoFilter 'Apply autor filter 
'***************************************************************************************
'Now loop through the rows starting from row 1 to 19 which is A1 to S1 and apply formating as below
Dim i As Integer
For i = 1 To 19
.Cells(1, i).Font.Bold = True
.Cells(1, i).Font.ColorIndex = 3
.Cells(1, i).Interior.ColorIndex = 37 
Next 'end of loop
'**************************************************************************************** 
.worksheets(1).Cells(2, 2).Activate ' make cell B2 as the active cell
.activewindow.freezepanes = True 'Now freezepanes from the active cell B2
.Visible = True
.range("a1").Select 'If for some reason if other cells are selected please select A1 as am now done. 
End With export _Click_Exit:
Exit Sub export _Click_Err:
MsgBox Error$
Resume export _Click_Exit
End Sub

您只需要在主/父窗体上创建一个按钮（在本例中为export），然后简单地复制并粘贴上面的代码即可。

切记按照如下方式更改子窗体名称，子窗体字段名称和cmd按钮名称

在代码中加下划线 。

From: https://bytes.com/topic/access/insights/941623-exporting-filtered-access-datasheet-excel-spreadsheet-no-truncation