仅通过选定的文件循环

你知道如何仅通过VBA文件夹中的选定文件循环吗？ 我设法做所有的文件循环的代码。 但是，我想缩短处理时间，使其仅打开我在代码中指定的文件。

Sub CopyDataFromCSTR() Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim i As Long Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual myPath = ActiveWorkbook.Path & "\" myExtension = "*.xlsx*" myFile = Dir(myPath & myExtension) 'attempt to set a criteria for the files to open - however the loop ends at first attempt Do While InStr(myFile, "Trans") <> 0 Set wb = Workbooks.Open(Filename:=myPath & myFile) 'do something to the opened file wb.Close SaveChanges:=False DoEvents myFile = Dir Loop Set wb = Nothing MsgBox ("Done!") ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 

Answer 1

这是从我最喜欢的树木漫步程序修改。 我省略了recursion调用，所以它只是search指定的文件夹。 通常我设置引用，但在这里我已经延迟了脚本对象。

对于这个POC我们只是打开文件，debug.print这个名字并closures它

 Sub ScanFldr(sFld As String, sPat As String) Dim fso As Object, fld As Object, fil As Object Dim wkb As Excel.Workbook Set fso = CreateObject("Scripting.FileSystemObject") Set fld = fso.GetFolder(sFld) If Right(sFld, 1) <> "\" Then sFld = sFld & "\" For Each fil In fld.Files If fil.Name Like sPat And Not (fil.Name Like "~$*" or fil.Name = thisWorkBook.Name) Then Set wkb = Workbooks.Open(Filename:=sFld & fil.Name, ReadOnly:=True, UpdateLinks:=False) Debug.Print "Opened " & fil.Name wkb.Close savechanges:=False End If DoEvents Next Set wkb = Nothing Set fso = Nothing End Sub 

呼叫例如

 ScanFldr thisworkbook.path, "*.xlsx*" 

请注意，要使用此工作簿path，则需要在运行macros之前保存包含代码的工作簿。

Answer 2

你在哪里有*。 在replacemyExtension =“. xlsx ”中，将*replace为文件的文件掩码。 例如：“FilesLikeThis.xlsx *”您可能想要将variables重命名为FileMask或更合适的。

例如，对于仅以hello开头的文件：

  myFileName = "hello*" myExtension = "xlsx*" myFile = Dir(myPath & myFileName & "." & myExtension) 

不要忘记为新variables添加一个Dim。

Answer 3

例如，我想只打开文件名中的其他字符中包含特定string的文件; “反式”。 文件名可能如下所示：20170311sdfsdfTransfasdfasd.xlsx或20170310fasdfTransasdfaw.xlsx。 有什么方法可以将INSTRfunction结合到识别我们要select的文件中？

 Sub CopyDataFromCSTR() Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim i As Long Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual myPath = ActiveWorkbook.Path & "\" myExtension = "*.xls*" myFile = Dir(myPath & myExtension) Do While myFile <> 0 

  if instr(myFile, "trans") > 0 then 'Check condition inside the loop instead of ending the do-while loop abruptly 

  Set wb = Workbooks.Open(Filename:=myPath & myFile) 'do something to the opened file wb.Close SaveChanges:=False DoEvents 

  End if 

  myFile = Dir Loop Set wb = Nothing MsgBox ("Done!") ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub