|
- 怎么实现下面功能,遍历制定文件夹下所有子文件夹和孙文件夹下的excel文件所有sheet的A1单元格内容,把结果汇总到Access中?
我已经知道怎么用excel实现这一功能了,现在请问怎么用Access来实现?谢谢啦
附件如下
汇总数据.zip
(26.11 KB, 下载次数: 38)
以前编写的excel VBA代码如下:
Sub test() - Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Dim arr$(), brr(1 To 100000, 1 To 4), n&, j&, sh As Worksheet
- p$ = ThisWorkbook.Path & "\"
- m% = 0
- Call GetFiles(arr, m, p)
- If m > 0 Then
- For j = 1 To UBound(arr, 2)
- With GetObject(arr(1, j))
- For Each sh In .Sheets
- If sh.[a1] <> "" Then
- n = n + 1
- brr(n, 1) = arr(2, j)
- brr(n, 2) = arr(3, j)
- brr(n, 3) = sh.[a1].Value
- brr(n, 4) = sh.Name
- End If
- Next
- .Close 0
- End With
- Next
- Range("A" & Cells(Rows.Count, 1).End(3).Row + 1).Resize(n, 4) = brr
- Else
- MsgBox "没有需要汇总的数据!"
- End If
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- End Sub
- Sub GetFiles(arr$(), m%, ByVal p$)
- 'p为遍历的路径,arr为存储文件路径数组
- Dim SubFolder As Object, tm, temp
- Dim File As Object, FSO As Object
- Set FSO = CreateObject("Scripting.FileSystemObject")
- Set Folder = FSO.GetFolder(p)
- For Each File In Folder.Files
- If File.Name Like "*.xlsx" Then
- tm = Format(File.DateLastModified, "yyyy-mm-dd")
- temp = Format(Now, "yyyy-mm-dd")
- If tm = temp Then
- m = m + 1
- ReDim Preserve arr(1 To 3, 1 To m)
- arr(1, m) = File
- arr(2, m) = Folder.Name
- arr(3, m) = Split(File.Name, ".")(0)
- End If
- End If
- Next
- For Each SubFolder In Folder.SubFolders
- Call GetFiles(arr, m, SubFolder.Path)
- Next
- End Sub
|
|