使用ADO+SQL读取数据文件夹里面的工作簿数据

cmo9020

请教各位导师一下,要使用SQL读取数据文件夹里面的工作簿，要怎么写？
需求是在TEST主控文档
Sheet1 B1单元格填入月份
Sheet1 D1单元格填入文件夹号码

Sheet1 D1单元格填入文件夹号码，执行后找出和Sheet1 B1单元格相同的月份文件夹

接着读取整个月份的目标工作簿中"Report"工作表 J3单元格序号填入反绿色的区块
接着目标工作簿A列A1~A5和Sheet1A1~A5 对应，
把目标工作簿的B列数据 填入到 Sheet1 反黄色地方

表格是整个月份的至少会有30-40个工作簿
看是否有导师能懂的帮忙一下，谢谢~

mmwwdd

这个用字典比较好

扑腾

看需求以为懂了，看附件中的例子数据又不懂了。不懂得到是： 取哪些数据，abcd?

cmo9020

扑腾 发表于 2023-4-15 10:35
看需求以为懂了，看附件中的例子数据又不懂了。不懂得到是： 取哪些数据，abcd?

大哥您好~需要取b列数据,也就是abcd

目前弄这样...想先从A列下手在来弄后续数据,但还是有问题


Option Explicit
Sub ReadReportData()
   

    Dim rootPath As String
    rootPath = "C:\Users\User\Desktop\Test\"
   

    Dim month As String
    month = Range("B1").Value
    Dim folderNum As String
    folderNum = Range("D1").Value
   

    Dim targetPath As String
    targetPath = rootPath & folderNum & "\" & month & "\"
   

    Dim conn As New ADODB.Connection
    conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & targetPath & ";Extended Properties='Excel 12.0 Xml;HDR=YES;'"
    conn.Open
   

    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    Dim folder As Object
    Set folder = fs.GetFolder(targetPath)
    Dim file As Object
    For Each file In folder.Files
        If Right(file.Name, 4) = "xlsx" Then
            Dim wb As New Workbook
            wb.Connections.Add conn, "", "SELECT * FROM [Report$]"
            wb.RefreshAll
            Dim reportSheet As Worksheet
            Set reportSheet = wb.Worksheets("Report")
            Dim lastRow As Long
            lastRow = reportSheet.Range("J" & Rows.Count).End(xlUp).Row
            Range("A3:A" & lastRow).Value = reportSheet.Range("J3:J" & lastRow).Value
            wb.Close False
        End If
    Next file
   
    conn.Close
   
End Sub

cmo9020

mmwwdd 发表于 2023-4-15 10:21
这个用字典比较好

请问怎么写,字典执行时会需要一个一个把目标工作簿打开吗?谢谢

fzxba

Test.rar (134.38 KB, 下载次数: 23)

2023-4-15 14:22 上传

点击文件名下载附件

cmo9020

fzxba 发表于 2023-4-15 14:22

请教导师一下...
这2个乱码的字是什么...谢谢您。

cmo9020

fzxba 发表于 2023-4-15 14:22

在请教导师一下,如果我目标工作表有增加行数,如图片目标工作表和当前工作表都增加A6
那代码须要修改那些部份呢？

  SQL = "SELECT F1 FROM [" & s & p & "[f]].[Report$J3:J3] UNION ALL SELECT F1 FROM [" & s & p & "[f]].[Report$B14:B18]"

还有
Function ProcessData(ar, br, rowSize As Long)
  Dim i As Long, j As Long, colSize As Long
  For i = 0 To UBound(br, 2) Step 6
    rowSize = rowSize + 1
    colSize = 0
    For j = i To i + 5
      colSize = colSize + 1
      ar(rowSize, colSize) = br(0, j)
    Next
  Next
End Function

是只需要修改这两部份就好吗？如何修改能麻烦您教一下吗？谢谢您

fzxba

cmo9020 发表于 2023-4-15 15:08
在请教导师一下,如果我目标工作表有增加行数,如图片目标工作表和当前工作表都增加A6
那代码须要修改那些 ...

cmo9020

fzxba 发表于 2023-4-15 15:59

Test.rar (134.76 KB, 下载次数: 1)

2023-4-15 20:06 上传

点击文件名下载附件

谢谢导师...在请教一下
我发现刚开始修改不成功能原因
就是所有目标工作簿必须都要相同有A6的存在才能复制

如果其中一个工作簿少了A6这名称就会显示  ar(rowSize, colSize) = br(0, j)数组索引超出范围
请问导师这个如果其中一个工作簿少了A6这个名称
能有办法能解决变那个工作簿中的A6就是空白吗？谢谢

例如：现在要查询4月项目 8038-2429999但是我"8038-2429999 G33288"这个工作簿里面没有A6
那怎么让他显示在sheet1时候 A6 是空白单元格
而不是产生数组索引超出范围