我有一个子文件夹循环脚本,用于确定Cells(2,3)
是否为空,如果为空,则继续删除该列。
我有一个通配符*
,这样就不需要命名任何文件,只需要命名扩展名。为什么这一行:MyFile = "*.xlsx"
不能提取实际的文件名?它只是在循环中显示为*.xlsx
,并退出sub,因为什么都没有找到。
基于答案的编辑代码:
Sub LoopSubfoldersAndFiles()
Dim folder As Object
Dim subfolders As Object
Dim MyFile As String
Dim wb As Workbook
Dim currentfile As Object, currentfolder As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Set subfolders = folder.subfolders
MyFile = "*.xlsx"
For Each subfolders In subfolders
Set CurrentFile = subfolders.Files
With New FileSystemObject ' reference Microsoft Scripting Runtime library
Dim root As folder
Set root = .GetFolder("C:\Users\pp87255\Desktop\JNav Rest\05.23.2019")
Dim subFolder As folder
For Each subFolder In root.subfolders
Dim currentfolder As folder
For Each currentfolder In subFolder.subfolders
Dim currentfile As File
For Each currentfile In currentfolder.Files
If currentfile.Name Like "*.xlsx" Then
Dim wb As Workbook
Set wb = Application.Workbooks.Open(currentfile.Path)
If wb.Sheets(1).Cells(2, 3).Value2 = "" Then
Columns(3).EntireColumn.Delete
End If
End If
Next
Next
Next
End With
Next
Set folder = Nothing
Set subfolders = Nothing
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
发布于 2019-05-24 02:22:40
我从"www.thespreadsheetguru.com“重新调整了这段代码的用途。它遍历我导航到的文件夹中的所有文件,并对它们进行格式化。
Private Sub FormatAllFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com
Dim WB As Workbook
Dim myPath As String
Dim MyFile As String
Dim myFileName As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim regionNumber As String
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "SELECT THE FOLDER WITH REPORT COLLECTION WORKBOOKS TO BE FORMATTED"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = ".xlsx"
'Target Path with Ending Extention
MyFile = Dir(myPath)
'branchLocation = fso.GetBaseName(Right(myFile, Len(myFile) - InStr(myFile, "_")))
GetSaveFileLocation
'Loop through each Excel file in folder
Do While MyFile <> ""
Application.DisplayAlerts = False
myFileName = fso.GetBaseName(MyFile)
'Set variable equal to opened workbook
Set WB = Workbooks.Open(fileName:=myPath & MyFile)
fName = myFileName & "_Formatted"
saveFileName = mySavePath & fName & myExtension
If WB.Application.ProtectedViewWindows.Count > 0 Then
WB.Application.ActiveProtectedViewWindow.Edit
End If
ExecutiveReportFormatting
regionNumber = getRegionNumber(myFileName)
WB.BuiltinDocumentProperties("Comments").Value = regionNumber
'Close Workbook
With WB
.SaveAs saveFileName
.Close
End With
'Get next file name
MyFile = Dir
Loop
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub
https://stackoverflow.com/questions/56280838
复制相似问题