access多个表导出到一个sheet

掌中烛火

我想把access数据多个表格的数据导出到一个sheet，每个表中间间隔一列，像附件里面的效果一样，如果实现，麻烦各位大哥帮助

fzxba

1. Sub test0() '简化一下
   
2.   
   
3.   Dim Conn As Object, rs As Object, SQL As String
   
4.   Dim i As Integer, j As Integer, p As Integer, t
   
5.   
   
6.   Cells.Clear
   
7.   
   
8.   Set Conn = CreateObject("ADODB.Connection")
   
9.   Set rs = CreateObject("ADODB.Recordset")
   
10.   
    
11.   Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\Database1.accdb"
    
12.   Set rs = Conn.OpenSchema(20) 'adSchemaTables
    
13.   Do
    
14.     If rs!TABLE_TYPE = "TABLE" Then t = t & "|" & rs!TABLE_NAME
    
15.     rs.MoveNext
    
16.   Loop Until rs.EOF
    
17.   If rs.State = 1 Then rs.Close
    
18.   
    
19.   t = Split(t, "|")
    
20.   For j = 1 To UBound(t)
    
21.     p = Cells(2, Columns.Count).End(xlToLeft).Column
    
22.     If p > 1 Then p = p + 2
    
23.     SQL = "SELECT * FROM " & t(j)
    
24.     Set rs = Conn.Execute(SQL)
    
25.     Cells(1, p) = t(j)
    
26.     For i = 0 To rs.Fields.Count - 1
    
27.       Cells(2, p).Offset(, i) = rs.Fields(i).Name
    
28.     Next
    
29.     Cells(3, p).CopyFromRecordset rs
    
30.   Next
    
31.   
    
32.   If rs.State = 1 Then rs.Close
    
33.   If Conn.State = 1 Then Conn.Close
    
34.   Set rs = Nothing
    
35.   Set Conn = Nothing
    
36.   Beep
    
37. End Sub

复制代码

fzxba

示例.rar (38.39 KB, 下载次数: 2)

2024-2-19 18:42 上传

点击文件名下载附件

掌中烛火

fzxba 发表于 2024-2-19 18:40

谢谢大哥，