excel - 使用 VBA 循环遍历定义的子文件夹
问题描述
如何修改代码以便查询文件夹(文件所在的位置)加上子文件夹?目前只读出文件所在的文件夹。我想用 True 或 False 激活这个功能(例如 AllSubfolders)。此外,一种通过指定不同路径来查询某些子文件夹的方法(为此,我将 AllSubfolders 函数设置为 false)。
不幸的是,经过几次尝试,我并没有取得这样的成功。我的VBA知识不好。
我试图用我的代码实现以下代码:
Dim FileSystem As Object
Dim HostFolder As String
HostFolder = "C:\Users\admin\Desktop\Dokumente\"
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)
Sub DoFolder(Folder)
Dim SubFolder
For Each SubFolder In Folder.SubFolders
DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
' Operate on each file
Next
End Sub
但没有成功。使用以下代码,我从活动工作簿文件夹中的多个文件中复制数据。我想为搜索子文件夹设置 True 或 False 并提供从中复制数据的特定路径。
Sub Copy_Data_from_Files_in_Folder()
ActiveSheet.Range("A4:I1000").ClearContents 'Vorgegebenen Tabelleninhalt vor dem Kopieren der Daten löschen
Dim StatusCalc
'Makrobremsen lösen - Am Beginn eines Makros
With Application
.EnableEvents = False
StatusCalc = .Application.Calculation 'Aktuellen Berechnungsmodus merken
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
'Const sXlsPath = "C:\Users\admin\Desktop\Dokumente\" 'Pfad zu bestimmtem Ordner
'oder wenn sich die Dateien im selben Ordner befinden
sXlsPath = ThisWorkbook.Path 'Datei im gleichen Ordner wie Auswertungsdateien
Const iStartZeile = 4 'Angeben, ab welcher Zeile eingefügt werden soll
Const iStartSpalte = 1 'Angeben, ab welcher Spalte eingefügt werden soll
Const Zellen = "D3,K3,K7,H34,R3,D5,K5,R5,A29" 'Angeben, welche Zellen kopiert werden sollen
Dim oFso As Object, oFile As Object, oWkb1 As Workbook, oWks0 As Worksheet, oWks1 As Worksheet
Dim aCells As Variant, iNextLine As Long, i As Integer
Set oWks0 = ThisWorkbook.ActiveSheet
aCells = Split(Zellen, ","): iNextLine = iStartZeile
Set oFso = CreateObject("Scripting.FilesystemObject")
For Each oFile In oFso.GetFolder(sXlsPath).Files
If LCase(oFso.GetExtensionName(oFile.Name)) = "xlsx" Then 'Hier den Dateityp anpassen
If ThisWorkbook.Path <> oFile.Name Then
Set oWkb1 = Workbooks.Open(oFile.Path)
Set oWks1 = oWkb1.Sheets(1)
For i = 0 To UBound(aCells)
oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i) = oWks1.Range(Trim(aCells(i))).Value
Next
oWkb1.Close False
iNextLine = iNextLine + 1
End If
End If
Next
Beenden: 'Sprungadresse zum Beenden diese Makros
'Makrobremsen zurücksetzen - vor dem Beenden eines Makros
With Application
.EnableEvents = True
.Calculation = StatusCalc
.ScreenUpdating = True
End With
End Sub
解决方案
推荐阅读
- javascript - 如何在静态页面和生成的页面之间共享查询?
- c++ - 在控制台中“垂直”输出向量的向量内容
- php - 通过模型关系删除laravel中的图像
- php - 对象数组的数组交集
- dll - 在一台 PC 上无法使用 PyInstaller 找到 DLL,但可以在另一台 PC 上找到
- python - 如何根据另一个数据框中的组在熊猫数据框中创建指标列?
- reactjs - 两个不同父母的孩子可以在 React 中拥有相同的键吗
- excel - UserForm ComboBox 从动态工作表列表填充,从第一个 ComboBox 的选择中添加第二个 ComboBox
- javascript - React Redux:我的 React 组件没有收到更新的数组作为道具
- c# - Process files concurrently and asynchronously