'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 区域是否含表头
Sub 汇总()
Dim filename As String
Dim wb As Workbook
Dim sht As Worksheet
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Application.ScreenUpdating = False '关闭屏幕更新
ThisWorkbook.Sheets(1).Cells.Clear
arr = Array("发票代码", "发票号码", "购方企业名称", "购方税号", "开票日期", "商品名称", "规格", "单位", "数量", "单价", "金额", "税率", "税额", "税收分类编码")
ThisWorkbook.Sheets(1).Range("A1:N1") = arr
filename = Dir(ThisWorkbook.Path & "\*.xlsx")
x = 2
Do While filename <> ""
If a <> "开票汇总.xlsm" Then
'不显示打开工作簿提取数据，使用workbook.open会打开Excel窗口
Set wb = GetObject(ThisWorkbook.Path & "\" & filename)
Set sht = wb.Worksheets(1)
endrow = sht.Range("O65536").End(xlUp).Row '取得最后一行非空行号
strTable = "[sheet1$A4:R" & endrow & "]" '含标题的数据区域
wb.Close
con.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 8.0;hdr=yes;imex=1';data source=" & ThisWorkbook.Path & "/" & filename
strSQL = "select 发票代码, 发票号码, 购方企业名称, 购方税号, 开票日期, 商品名称, 规格, 单位, 数量, 单价, 金额, 税率, 税额, 税收分类编码 from " & strTable & " where 商品名称<>'小计'"
Set rs = con.Execute(strSQL)
ThisWorkbook.Sheets(1).Range("A" & x).CopyFromRecordset rs
filename = Dir
x = ThisWorkbook.Sheets(1).Range("K65536").End(xlUp).Row + 1
con.Close
End If
Loop
Set con = Nothing
Set rs = Nothing
Application.ScreenUpdating = True
Call FillBlank("a:e")
MsgBox "OK"
End Sub
'填充空白单元格
Sub FillBlank(area As String)
Dim rngBlank As Range, rngArea As Range
Set rngBlank = Range(area).SpecialCells(xlCellTypeBlanks) '空单元格
For Each rngArea In rngBlank.Areas
rngArea.Cells(1, 1).Offset(-1, 0).Resize(rngArea.Rows.Count + 1, rngArea.Columns.Count).FillDown
Next rngArea
End Sub
