多个工作簿内容查询

janemark

janemark 发表于 2021-12-25 09:17
运行错误3706

看看这个调试，

xiangbaoan

你莫不是用WPS，或是office安装不完整？

janemark

xiangbaoan 发表于 2021-12-25 09:13

也是运行错误3706

janemark

xiangbaoan 发表于 2021-12-25 09:23
你莫不是用WPS，或是office安装不完整？

我用的是WPS

xiangbaoan

janemark 发表于 2021-12-25 09:26
我用的是WPS

换 Office Excel 用，这里是没任何问题的。

janemark

xiangbaoan 发表于 2021-12-25 09:27
换 Office Excel 用，这里是没任何问题的。

现在都用WPS啊，哪还用office excel呢。能修改一下代码吗，让WPS也可以使用。

xiangbaoan

janemark 发表于 2021-12-25 09:30
现在都用WPS啊，哪还用office excel呢。能修改一下代码吗，让WPS也可以使用。

那就要一个个打开了，不合你的要求。
等后面的老师写吧。

janemark

xiangbaoan 发表于 2021-12-25 09:32
那就要一个个打开了，不合你的要求。
等后面的老师写吧。

电脑上有WPS和OFFICE，我用OFFICE运行代码，还是显示错误3706，不知什么原因？

xiangbaoan

janemark 发表于 2021-12-25 09:42
电脑上有WPS和OFFICE，我用OFFICE运行代码，还是显示错误3706，不知什么原因？

12楼说了……
不行就改变，若不改变，就放弃吧……

xiangbaoan

Sub 可用于WPS()          '已测试，可用于WPS，一定要安装 AccessDatabaseEngine
  Dim Cnn As Object, strCnn As String, SQL As String, p As String, f As String, s As String
  ActiveSheet.UsedRange.Offset(2).ClearContents
  Application.ScreenUpdating = False
  Set Cnn = CreateObject("ADODB.Connection")
  strCnn = "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=no';Data Source ="
  SQL = "SELECT f1,f2,f5,'[s]' FROM [$C4:G] WHERE f1 LIKE '%" & Range("B1").Value & "%'"
  p = ThisWorkbook.Path & "\"
  f = Dir(p & "*.xls?")
  While Len(f)
    If f <> ThisWorkbook.Name Then
      Cnn.Open strCnn & p & f
      s = Split(f, ".")(0)
      Cells(Rows.Count, 1).End(xlUp).Offset(1).CopyFromRecordset Cnn.Execute(Replace(SQL, "[s]", Split(f, ".")(0)))
      Cnn.Close
    End If
    f = Dir
  Wend
  Set Cnn = Nothing
  Application.ScreenUpdating = True
  Beep
End Sub