How to identify a code in file name and open that file in a folder? The codes below don't work...

[ironny90]

Hi everyone, I am working with a lot of templates to update for this month. One of the tasks is to find the report for a specific template (located in another folder), open it, go to a tab, copy the content and paste to another tab in the template. The big issue is how to identify the report that goes with the template.

In cell A3 of each template, there is a BU code that is included in the file name of the report (but the file name is much longer than that - it's named as region_BU code_XXXXXXXXXXX, where the "X" can be any). I am trying to find the BU code in the file name and open that file. The codes below actually opened one file, but nothing was copied and pasted. So I was not sure what happened... I am a newbie so any help will be much appreciated!

Sub Macro1()
Set fso = CreateObject("scripting.filesystemobject")
Set ff = fso.getfolder("C:\Users\Desktop\training\Win\Win_1\summary\test")
For Each file In ff.Files
Workbooks.Open file
Set wbk2 = ActiveWorkbook
Sheets("Summary").Select

rngY = Range("A3").Value

Dim fname As Variant
Dim myPath As String

myPath = "C:\Users\Desktop\training\Win\Win_1\MLA\reports"
[B]fname = Dir(myPath & "*rngY*")   '- I am not sure if this is the right way to identify the report?[/B]

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

 

[ironny90]

rngY = Range("A3").Value

Dim pSTR As String
Dim strFile As String
Dim WB As Workbook
Dim dirFile As String


pSTR = "C:\Users\Win\Win_1\MLA\reports"
strFile = "*" & rngY & "*" & ".xlsx"
dirFile = Dir(pSTR & strFile)

Set WB = Workbooks.Open(pSTR & dirFile)

just tried these and still didn't work... error msg at last line...

 

[GWteB]

I would like to make a few remarks.

• Although you have explicitly declared some variables used, you have not declared all of them. Therefore always use Option Explicit (take a look over here), then you will be reminded at compile time.
• If a folder path and a filename are being concatenated, there needs to be a path separator in between them.
• There's almost never any need to Activate workbooks and Select worksheet ranges. If you make sure objects are properly qualified, you can usually immediately apply the desired method or function to them.

I made some changes to your code. Compare this code with your own, maybe you'll understand what I mean.
I'm not sure about the desired program flow because your code goes through at least one folder using a For Next construction, but also looks for a file in another folder using wildcards. I have not tested the code below. In case of problems, let me know.

Sub ironny90()

    Dim fso As Object, ff As Object, file As Object
    Dim wbk1 As Workbook, wbk2 As Workbook, SourceSht As Worksheet, rngY As String

    Set fso = CreateObject("scripting.filesystemobject")
    Set ff = fso.getfolder("C:\Users\Desktop\training\Win\Win_1\summary\test")

    For Each file In ff.Files

        Set wbk2 = Workbooks.Open(file)
        rngY = Sheets("Summary").Range("A3").Value

        Dim fname As Variant
        Dim myPath As String

        myPath = "C:\Users\Desktop\training\Win\Win_1\MLA\reports\"     ' << note the ending "\"

        fname = Dir(myPath & "*" & rngY & "*.*")

        If fname <> "" Then

            Set wbk1 = Workbooks.Open(myPath & fname)
            Set SourceSht = wbk1.Sheets("Assumptions Report")

            Excel.Application.Calculation = xlCalculationManual
            With wbk2.Sheets("3-22")
                SourceSht.Cells.Copy Destination:=.Range("A1")
                .UsedRange.Value = .UsedRange.Value
            End With
            Excel.Application.Calculation = xlCalculationAutomatic
            
            Dim rFound As Range
            Set rFound = wbk2.Sheets("Summary").Range("A10:A100").Find(Format("44651", "mmm-yy"), , xlValues, xlPart, xlByRows, xlNext, False, False, False)

            If Not rFound Is Nothing Then

                wbk1.Sheets("New Report").Range("D10").Copy
                rFound.Offset(0, 3).PasteSpecial Paste:=xlPasteValues
                wbk1.Close SaveChanges:=False                           ' << in source workbook nothing has been changed, why bother to save it??
            End If

        End If

        wbk2.Save
        wbk2.Close

    Next
End Sub

 

[ironny90]

Hi GWteB, thank you so much for your help! Yea I see what you mean and let me try and see what happens.

​