如何识别文件名中的代码并在文件夹中打开该文件

Question

我正在使用本月更新的模板。其中一项任务是找到特定模板(位于另一个文件夹中(的报告，打开它，转到一个选项卡，复制内容并粘贴到模板中的另一个选项卡。

在每个模板的单元格A3中，报告的文件名中有一个BU代码(该文件名为region_BU code_XXXXXXXXXX，其中"X"可以是任何一个(。

我正在尝试在文件名中找到BU代码并打开该文件。

代码打开了一个文件，但没有复制和粘贴任何内容。

Sub Macro1()
Set fso = CreateObject("scripting.filesystemobject")
Set ff = fso.getfolder("C:UsersWin_1summarytest")

For Each file In ff.Files

Workbooks.Open file
Set wbk2 = ActiveWorkbook
Sheets("Summary").Select

rngY = Range("A3").Value

Dim fname As Variant
Dim myFile As String

myPath = "C:UsersWin_1MLAreports"
fname = Dir(myPath & "*rngY*")

If fname <> "" Then
Workbooks.Open (myPath & fname)
Set wbk1 = ActiveWorkbook
Sheets("Assumptions Report").Cells.Select
Selection.Copy
wbk2.Activate
Sheets("3-22").Select
Range("A1").Select
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
wbk1.Activate
Sheets("New Report").Range("D10").Select
Selection.Copy
wbk2.Activate
Sheets("Summary").Select
Dim rFound As Range
Set rFound = Range("A10:A100").Find(Format("44651", "mmm-yy"), , xlValues, xlPart, xlByRows, xlNext, False, False, False)

If Not rFound Is Nothing Then rFound.Select

ActiveCell.Offset(0, 3).PasteSpecial Paste:=xlPasteValues
wbk1.Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
wbk2.Activate
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close

Next

End Sub

Answer 1

我对您的代码进行了一些调整，如下(参见注释(

Sub Macro1()
Set fso = CreateObject("scripting.filesystemobject")
Set ff = fso.getfolder("C:UsersWin_1summarytest")

For Each file In ff.Files
Set wbk2 = Workbooks.Open(file) 'this is better than relying on Activeworkbook once you've opened the file.
wbk2.Sheets("Summary").Select

rngY = Range("A3").Value

Dim fname As Variant
Dim myFile As String

myPath = "C:UsersWin_1MLAreports"
fname = Dir(myPath & "*" & rngY& "*")

If fname <> "" Then
Set wbk1 =  Workbooks.Open(myPath & fname)
wbk1.Sheets("Assumptions Report").Cells.Copy 'avoid using Select wherever possible.
wbk2.Activate
Sheets("3-22").Activate
Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
wbk1.Activate
Sheets("New Report").Range("D10").Copy
wbk2.Activate
Sheets("Summary").Activate
Dim rFound As Range
Set rFound = Range("A10:A100").Find(Format("44651", "mmm-yy"), , xlValues, xlPart, xlByRows, xlNext, False, False, False)

If Not rFound Is Nothing Then 
rFound.Offset(0, 3).PasteSpecial Paste:=xlPasteValues
End If
wbk1.Save
wbk1.Close
End If
wbk2.Save
wbk2.Close

Next

End Sub