Private Sub Command2_Click()

????Dim ex As Object, wb As Workbook, sht As Worksheet, path_name As String, fdialog As Object

????t = Timer

????Set fdialog = Access.Application.FileDialog(msoFileDialogFilePicker)

????With fdialog

????????.initialfilename = CurrentProject.Path

????????.allowmultiselect = False

????????.Filters.Clear

????????.Filters.Add "excel文件", "*.xlsx;*.xls"

????????If .Show = True Then

????????????Me.Text0 = .selecteditems(1)

????????Else

????????????MsgBox "沒有選擇文件，程序退出"

????????????Exit Sub

????????End If

????End With

????Set ex = CreateObject("excel.application")

????Set wb = ex.Workbooks.Open(Me.Text0)

'????ex.ScreenUpdating = False

????Dim rs As New ADODB.Recordset

????Dim link As New ADODB.Connection

????前綴 = "select * from ["

????后綴 = "$] union all "

????For Each sht In wb.Worksheets

????????SQL = SQL & 前綴 & sht.Name & 后綴

????Next

????SQL = Left(SQL, Len(SQL) - 11)

????Debug.Print SQL

????link.Open "Provider=Microsoft.ACE.OLEDB.12.0;Persist Security Info=False;Data Source=" & Me.Text0 & ";Extended Properties='Excel 12.0;HDR=Yes'"

????rs.Open SQL, link, 1, 3

????wb.Sheets.Add.Name = "合并"

????For i = 0 To rs.Fields.Count - 1

????????wb.Sheets("合并").Cells(1, i + 1) = rs.Fields(i).Name

????Next

????wb.Sheets("合并").Range("a2").CopyFromRecordset rs

????Debug.Print rs.RecordCount

????rs.Close

????link.Close

????wb.Save

????wb.Close

'????ex.ScreenUpdating = True

????MsgBox "處理完成" & Round(Timer - t, 2) & "s"

????Set ex = Nothing

????Set wb = Nothing

????Set link = Nothing

????Set wb = Nothing

End Sub