用ado导入多个工作簿的问题

ylj518

提示找不到表，不知哪里错了，请高手指点！

limonet

fi是什么？

shiruiqiang

首先:strtable的名称都不是sheet1

abc123281

1. Sub adodl()
   
2. Dim StrSQL$, Cn As Object, x%
   
3. Dim fileName, strTable, strPath
   
4. Set Cn = CreateObject("ADODB.connection")
   
5. Sheet16.Range("a:g").ClearContents
   
6. Sheet16.Range("a1:f1") = Array("班级", "考号", "性别", "语文", "数学", "英语")
   
7. strPath = ThisWorkbook.Path & ""
   
8. fileName = Dir(strPath & "*.xlsx")
   
9. x = 2
   
10. Do While fileName <> ""
    
11.   If fileName <> "汇总.xlsm" Then
    
12.     Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;hdr=no;imex=1';Data Source=" & strPath & fileName
    
13.     StrSQL = "select * from .[Sheet1$a2:f]"
    
14.     Sheet16.Range("a" & x).CopyFromRecordset Cn.Execute(StrSQL)
    
15.     x = Sheet16.Cells(Rows.Count, 1).End(xlUp).Row + 1
    
16.     Cn.Close
    
17.   End If
    
18.   fileName = Dir()
    
19. Loop
    
20. Set Cn = Nothing
    
21. End Sub
    

复制代码

abc123281

ado导入1.rar (46.02 KB, 下载次数: 10)

2024-7-28 16:42 上传

点击文件名下载附件

quqiyuan

练习了一下，仅供参考。。。。

ylj518

非常感谢！abc123281中 StrSQL = "select * from [Sheet1$a2:f]"，改成 StrSQL = "select * from [a2:f]"，运行也很正常。quqiyuan中注释掉这句s = Replace(rst.Fields(2).Value, "'", "")，也可正常运行。为什么呢？

quqiyuan

ylj518 发表于 2024-7-28 19:31
非常感谢！abc123281中 StrSQL = "select * from [Sheet1$a2:f]"，改成 StrSQL = "select * from [a2:f]" ...

测试了一下，默认是第一个工作表，所以那样写没什么问题。甚至前面的set rst那个都可以不要。如果需要更多的工作表那就读取不到了，需要多写些代码了。

ykcbf1100

简单合并，copy法。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.7.28
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("scripting.filesystemobject")
   
5.     Set sh = ThisWorkbook.Sheets("合并")
   
6.     sh.UsedRange.Clear
   
7.     p = ThisWorkbook.Path & ""
   
8.     For Each f In fso.GetFolder(p).Files
   
9.         If InStr(f.Name, ThisWorkbook.Name) = 0 Then
   
10.             fn = fso.GetBaseName(f)
    
11.             m = m + 1
    
12.             Set wb = Workbooks.Open(f, 0)
    
13.             With wb.Sheets(1)
    
14.                 r = IIf(m = 1, 1, sh.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row)
    
15.                 .UsedRange.Offset(IIf(m = 1, 0, 1)).Copy sh.Cells(r, 1)
    
16.                 wb.Close 0
    
17.             End With
    
18.         End If
    
19.     Next f
    
20.     Application.ScreenUpdating = True
    
21.     MsgBox "汇总完毕!"
    
22. End Sub
    
23. 
    

复制代码