- 帖子
- 353
- 主題
- 5
- 精華
- 0
- 積分
- 386
- 點名
- 0
- 作業系統
- windows7
- 軟體版本
- vba,vb,excel2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2017-1-8
- 最後登錄
- 2024-5-4
 
|
Sub test2()
Set CN = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
Set s = Sheets("順序"): Set s0 = Sheets("集中"): s0.Cells.ClearContents
AR = Array("select * from [sheet1$A:I]", "select * from [工作表1$A:I]")
For i = 2 To s.Cells(Rows.Count, 2).End(3).Row
If Dir(ThisWorkbook.Path & "\" & s.Cells(i, "C") & ".xlsx") <> "" Then
CN.Open V & "Data Source=" & ThisWorkbook.Path & "\" & s.Cells(i, "C") & ".xlsx"
On Error Resume Next
Set rs = CN.Execute("select * from [" & s.Cells(i, "D") & "$A:I]")
If CN.Errors.Count <> 0 Then: CN.Errors.Clear: Set rs = CN.Execute(AR(0))
If CN.Errors.Count <> 0 Then: CN.Errors.Clear: Set rs = CN.Execute(AR(1))
On Error GoTo 0
s0.Range(s.Cells(i, "E") & 2).CopyFromRecordset rs
s0.Columns(s.Cells(i, "E").Value).NumberFormatLocal = "h:mm:ss;@"
s0.Range(s.Cells(i, "E") & 6).Resize(1, 9) = Split("A,B,C,D,E,F,G,H,I", ",")
CN.Close
End If
Next
End Sub |
|
發表於 2023-10-16 13:56
| 