excel - 如何使用 VBA 从特定子文件夹打开 xlsm 文件?
问题描述
我正在研究从剪贴板获取路径的宏,遍历此路径中的每个文件夹和子文件夹,在财务子文件夹中打开 xlsm 文件并删除KPI表。您可以在下面找到我的路径中的文件夹结构:
P:\主文件夹\项目文件夹\财务子文件夹\
P:\主文件夹\项目文件夹\简要子文件夹\
P:\主文件夹\项目文件夹\生产子文件夹\
P:\主文件夹\项目文件夹\交付子文件夹\
P:\主文件夹\项目文件夹\反馈子文件夹\
基本上,我复制“P:\main folder\”,我的宏遍历所有项目文件夹和所有子文件夹。我想优化此过程并编写一个代码,该代码遍历主文件夹中的所有项目文件夹,然后仅进入财务子文件夹并查找 xlsm 文件。我尝试使用此处发布的代码,但仅当我放置“P:\main folder\project folder\”路径时才有效,而不是放置“P:\main folder\”路径。
据我所知,原因是我的宏不是在项目文件夹中而是在主文件夹中寻找财务子文件夹,但这只是我的猜测。您可以在下面找到代码:
Sub test_macro()
Dim oLibrary As Object
Dim srcFolder As Object
Dim folderName As String
Dim clipboard As MSForms.DataObject
Dim CopiedText As String
Set clipboard = New MSForms.DataObject
clipboard.GetFromClipboard
CopiedText = clipboard.GetText
folderName = CopiedText
If StrPtr(folderName) = 0 Then
Exit Sub
End If
Set oLibrary = CreateObject("Scripting.FileSystemObject")
Merge_Rows oLibrary.GetFolder(folderName)
End Sub
Sub Merge_Rows(srcFolder As Object)
Dim srcSubFolder As Object
Dim srcFile As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
For Each srcSubFolder In srcFolder.SubFolders
If Split(srcSubFolder, "\")(UBound(Split(srcSubFolder, "\"))) = "1_FINANCE" Then '<-- my guess is that here is the problem but not sure how to fix it
Merge_Rows srcSubFolder
End If
Next
For Each srcFile In srcFolder.Files
If LCase(srcFile.Name) Like "*.xlsm" Then
Set wbkSource = Workbooks.Open(srcFile)
On Error Resume Next
Application.DisplayAlerts = False
wbkSource.Sheets("KPI").Delete
Application.DisplayAlerts = True
wbkSource.Close SaveChanges:=True
End If
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
如何更改代码以使其通过每个项目文件夹,然后仅用于财务子文件夹并省略其他代码?
解决方案
这是我的想法,但它是为 2 级子文件夹完成的(如果我正确理解了任务):
Sub Merge_Rows()
Dim srcFolder As Object
Dim srcSubFolder As Object
Dim srcSubSubFolder As Object
Dim srcFile As Object
Dim oLibrary As Object
' This is my testing vars
Dim FolderName As String
FolderName = "P:\"
'''''''''
' will need it as I'm not passing the folder to sub
Set oLibrary = CreateObject("Scripting.FileSystemObject")
Set srcFolder = oLibrary.getfolder(FolderName)
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' added for testing purposes
Dim fileCounter As Long
Debug.Print "-----------------" & "Source folder: " & FolderName & "--------------------------------"
Debug.Print Chr(10)
For Each srcSubFolder In srcFolder.Subfolders ' going to subfolders
' print the level 1 subfolder name, which should be a project folder
For Each srcSubSubFolder In srcSubFolder.Subfolders ' going to sub-subfolder
' print the level 2 subfolder name, which should be a project folder subfolder
Debug.Print "----------- Current SubFolder is: " & FolderName & srcSubFolder.Name & "-----------------"
If UCase(srcSubSubFolder.Name) Like "*FINANCE*" Then '<--!! put proper pattern
' go through it at once
For Each srcFile In srcSubSubFolder.Files
Debug.Print "----------------- Current SubSubFolder is: " & FolderName & srcSubFolder.Name & "\" & srcSubSubFolder.Name & "---------------------"
If LCase(srcFile.Name) Like "*.xlsm" Then
Debug.Print srcFile.Name
fileCounter = fileCounter + 1
' Your code here
End If
Next
End If
If Not fileCounter = 0 Then
Debug.Print "There were " & fileCounter & " .xlsm files in " & FolderName & srcSubFolder.Name & "\" & srcSubSubFolder.Name
fileCounter = 0
Else
Debug.Print "The search of .xlsm files in " & FolderName & srcSubFolder.Name & "\" & srcSubSubFolder.Name & " was not performed"
End If
Debug.Print "-----------------" & "End of current SubSubFolder: " & FolderName & srcSubFolder.Name & "\" & srcSubSubFolder.Name & "---------------------"
Next
Debug.Print "-----------------" & "End current SubFolder: " & FolderName & srcSubFolder.Name & "---------------------"
Debug.Print Chr(10) & Chr(10)
Next
Debug.Print "<-----------------" & "End Source Folder" & "--------------------->"
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
它看起来像这样 如果它适合 - 你需要为你的解决方案修复它,这只是一个想法:)
根据 OP 评论更新
我用更多Debug.Print
的行更新了代码 这里是我为测试创建的文件树:
每个文件夹都有一个“Book3.xlsm”文件。这是更新脚本的结果:
尝试运行至少一次项目文件夹迭代并检查即时窗口。
推荐阅读
- karate - 使用另一个变量从不同的功能文件调用场景
- python - 访问 Python 包中的类变量
- macos - 如何在mac上的不同帐户中共享docker镜像
- julia - 如何在宏中将字符串转换为特定的枚举类型?
- azure-devops - 如何在 DevOps 用户故事和任务中导出讨论线程
- azure-data-explorer - 导出 ADX Kusto 时间序列
- python - 在 Google Analytics API 中使用多个表达式
- svelte - 在 svelte 3 中迭代槽(子)
- json - 在 groovy 中解析嵌套的 json 对象
- php - 密码更改后 WordPress 注销“出现问题”消息