Dim a As String, n As Integer, wbs As Workbook
ThisWorkbook.Sheets(1).Cells.Clear
a = Dir(ThisWorkbook.Path & "\*.xls")
'Application.DisplayAlerts = False
'Workbooks.Open ThisWorkbook.Path & "\" & a
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
arr = Array("序号", "发票代码", "发票号码", "税收分类编码", "货物或应税劳务名称", "规格型号", "单位", "数量", "单价", "金额", "税率", "税额")
strTable = "[货物信息$A2:L500]"
ThisWorkbook.Sheets(1).Range("A1:L1") = arr
x = 2
Do While a <> ""
If a <> "购进汇总.xlsm" Then
con.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=yes;imex=1';data source=" & ThisWorkbook.Path & "/" & a
strSQL = "select 序号,发票代码,发票号码,税收分类编码,货物或应税劳务名称,规格型号,单位,数量,单价,金额,税率,税额 from " & strTable
Set rs = con.Execute(strSQL)
ThisWorkbook.Sheets(1).Range("A" & x).CopyFromRecordset rs
a = Dir
x = ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Row + 1
con.Close
End If
Loop
'Application.DisplayAlerts = False
Set con = Nothing
注:
'xlsx cnADO.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 8.0;hdr=no;imex=1';data source=" & strPath
'xls cnADO.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=yes;imex=1';data source=" & ThisWorkbook.Path & "/" & a
'hdr 区域是否含表头
