请教！如何将不同的表导出到同一个Excel中？

sxgaobo

请教各位大侠！如何用代码将不同的表导出到同一个Excel的不同的工作表中？

tmtony

控制 Excel.Application
然后 用Worksheets.add 添加一个新的工作表 然后把内容写进去
大致可能是这样的原理

Henry D. Sy

方法很多，不知道哪种适合你，
最好传上例子

sxgaobo

Henry D. Sy 发表于 2016-10-22 17:20
方法很多，不知道哪种适合你，
最好传上例子

    DoCmd.OutputTo acTable, "表1", "MicrosoftExcelBiff8(*.xls)", "D:\123\导出数据.xls", False, "", 0
    DoCmd.OutputTo acTable, "表2", "MicrosoftExcelBiff8(*.xls)", "D:\123\导出数据.xls", False, "", 0
这个一运行就提示是否覆盖已有的  导出数据.xls  

Henry D. Sy

sxgaobo 发表于 2016-10-22 17:42
DoCmd.OutputTo acTable, "表1", "MicrosoftExcelBiff8(*.xls)", "D:\123\导出数据.xls", False, "", ...

这个是最简单的导出
而且会覆盖同文件名的

sxgaobo

tmtony 发表于 2016-10-22 17:05
控制 Excel.Application
然后 用Worksheets.add 添加一个新的工作表 然后把内容写进去
大致可能是这样的 ...

能麻烦您给做个例子吗？

Henry D. Sy

sxgaobo 发表于 2016-10-22 18:56
能麻烦您给做个例子吗？

1. Private Sub Command0_Click()
   
2. 
   
3.     Dim rs As New ADODB.Recordset
   
4.     Dim rst As New ADODB.Recordset
   
5.     Dim sSQL As String
   
6.     Dim xlApp As New Excel.Application
   
7.     Dim xlBook As Workbook
   
8.     Dim xlSheet As Worksheet
   
9.     Dim i As Integer
   
10. 
    
11.     On Error GoTo Command0_Click_Error
    
12. 
    
13.     Set xlApp = CreateObject("Excel.Application")
    
14.     Set xlBook = Nothing
    
15.     Set xlSheet = Nothing
    
16.     Set xlBook = xlApp.Workbooks().Add
    
17.     xlBook.SaveAs CurrentProject.Path & "" & Format(Now(), "yyyy mmdd hhmm") & " UNION.xlsx"
    
18.     sSQL = "SELECT MSysObjects.Name FROM MSysObjects WHERE (((MSysObjects.Type)=1) AND ((Left([name],4))<>'msys')) ORDER BY MSysObjects.Name DESC"
    
19.     rs.Open sSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
    
20.     Do While Not rs.EOF
    
21.         Set xlSheet = xlBook.Worksheets.Add
    
22.         xlSheet.Name = rs.Fields(0)
    
23.         rst.Open xlSheet.Name, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
    
24.         For i = 0 To rst.Fields.Count - 1
    
25.             xlSheet.Cells(1, i + 1) = rst.Fields(i).Name
    
26.         Next
    
27.         xlSheet.Range("A2").CopyFromRecordset rst
    
28.         rst.Close
    
29.         rs.MoveNext
    
30.     Loop
    
31.     rs.Close
    
32.     Set rst = Nothing
    
33.     Set rs = Nothing
    
34.     xlBook.Save
    
35.     xlApp.WindowState = xlMaximized
    
36.     xlApp.Application.Visible = True
    
37.     Set xlSheet = Nothing
    
38.     Set xlBook = Nothing
    
39.     Set xlApp = Nothing
    
40. 
    
41.     On Error GoTo 0
    
42.     Exit Sub
    
43. 
    
44. Command0_Click_Error:
    
45. 
    
46.     MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
    
47. End Sub

复制代码

Henry D. Sy

忘记说要引用

sxgaobo

Henry D. Sy 发表于 2016-10-25 17:22
忘记说要引用

谢谢！辛苦了~~~！！！