求助关于表导出的问题

huangyz_xy

我需要将一个表导出，只需要导出表头（字段名称），而表中实际的内容有很多行，这样可以？

可能上面我没有表达清楚，我用docmd.outputTo 导出表1的时候是将表里面的所有数据全部导出到一个EXCEL，但是我不需要内容，只需要字段头，有什么解决办法没？

djt

打开表，全选一条记录，复制，到EXCEL，粘贴

huangyz_xy

大哥，我要用代码，能行不？DoCmd.OutputTo acOutputTable

rockfish1976

Dim excelapp As Excel.Application
Dim excelwbk As Excel.Workbook
Dim excelwst As Excel.Worksheet
Set excelapp = New Excel.Application
Set excelwbk = excelapp.Workbooks.Add
Set excelwst = excelwbk.Worksheets.Add

定义个记录集rstfld，利用循环导出

For i = 1 To rstfld.Fields.Count
    excelwst.Cells(1, i) = rstfld.Fields(i - 1).Name
Next

excelwbk.SaveAs

djt

导出到哪？

huangyz_xy

用代码导出到Excel

djt

Sub ExportField(strTableName As String)
    Dim myxl As Object
    Dim rs As New ADODB.Recordset
    Dim n As Integer
    rs.Open "select top 1 * from " & strTableName, CurrentProject.Connection
    Set myxl = CreateObject("excel.application")
    myxl.Visible = True
    myxl.workbooks.Add
    With myxl.activeworkbook.activesheet
    For n = 1 To rs.Fields.Count
        .cells(, n) = rs.Fields(n - 1).Name
    Next
    End With
End Sub
Sub test()
    Call ExportField("workbom")
End Sub

lanshai

ooooooooooo

huangyz_xy

基本解决了我目前的疑虑,还可不可以再进一步,就是说我要自己设定输出目录(变量PATH),效果和DoCmd.OutputTo acOutputTable, "11", "MicrosoftExcelBiff8(*.xls)", Path & "\11.xls", False一样,可以实现不?

djt

Sub ExportField(strTableName As String,strPath as string)
    Dim myxl As Object
    Dim rs As New ADODB.Recordset
    Dim n As Integer
    rs.Open "select top 1 * from " & strTableName, CurrentProject.Connection
    Set myxl = CreateObject("excel.application")
    myxl.Visible = True
    myxl.workbooks.Add
    With myxl.activeworkbook.activesheet
    For n = 1 To rs.Fields.Count
        .cells(, n) = rs.Fields(n - 1).Name
    Next
    End With
    myxl.activeworkbook.saveas strpath & "11.xls"
End Sub
Sub test()
    Call ExportField("workbom","c:\huangyz\")
End Sub