标签：ThisWorkbook rs Excel Range 文件夹 开具 Sheets 购方 con

不打开Excel文件提取数据？

Dim a As String, n As Integer, wbs As Workbook
ThisWorkbook.Sheets(1).Cells.Clear
a = Dir(ThisWorkbook.Path & "\*.xlsx")
'Application.DisplayAlerts = False

Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
arr = Array("发票代码", "发票号码", "购方企业名称", "购方税号", "开票日期", "商品名称", "规格", "单位", "数量", "单价", "金额", "税率", "税额", "税收分类编码")


ThisWorkbook.Sheets(1).Range("A1:N1") = arr
x = 2
Do While a <> ""
If a <> "开票汇总.xlsm" Then
Workbooks.Open ThisWorkbook.Path & "\" & a
endrow = Range("O65536").End(xlUp).Row
strTable = "[sheet1$A4:R" & endrow & "]"
For i = 5 To endrow
商品 = Range("J" & i)
Next
Workbooks(a).Close
con.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 8.0;hdr=yes;imex=1';data source=" & ThisWorkbook.Path & "/" & a
strSQL = "select 发票代码, 发票号码, 购方企业名称, 购方税号, 开票日期, 商品名称, 规格, 单位, 数量, 单价, 金额, 税率, 税额, 税收分类编码 from " & strTable & " where 商品名称<>'小计'"
Set rs = con.Execute(strSQL)
ThisWorkbook.Sheets(1).Range("A" & x).CopyFromRecordset rs
a = Dir
x = ThisWorkbook.Sheets(1).Range("K65536").End(xlUp).Row + 1
con.Close
End If
Loop
'Application.DisplayAlerts = False
Set con = Nothing
Set rs = Nothing

标签：ThisWorkbook,rs,Excel,Range,文件夹,开具,Sheets,购方,con
来源： https://www.cnblogs.com/ttsysy/p/16387589.html

本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享；
2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关；
3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关；
4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除；
5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。