How to save file in subfolder

[BlokeMan]

Hi,

I have a macro that search for existing files, creates and saves. What I want is it's going to save the file to the existing subfolders which is JAN to DEC based on the date (which is month) and it's going to do filesearch all the subfolder for existing file.

Thanks

Private Sub Workbook_Open()
Dim OpenName, PON As String, CODE As String, Response As String, PONMessage As String, MyString As String


Application.ScreenUpdating = False

OpenName = ActiveWorkbook.Name  'Check file name
PONMessage = "You have not entered a PON Number. To enter a PON press 'Yes', to exit sheet press 'No'."
If OpenName = "Polybag Load Reconciliation.xls" Then  ' If file is the template

    Do While PON = ""
        PON = InputBox("Please enter the PON of the new batch: ", "Enter PON") ' Enter PON Number
        If PON = "" Then ' Check if entry or cancel has been hit
            Response = MsgBox(PONMessage, vbYesNo, "PON Error") ' Error message explaining that they either need to enter a valid PON or exit sheet
            If Response = vbYes Then ' if 'YES' then continue loop
            Else
                ActiveWorkbook.Close savechanges:=False ' Close template without saving
            End If
        End If
          
        If Len(PON) = 6 Then            ' If PON contains 6 characters then
            If IsNumeric(PON) = True Then ' If the string contains only numbers then
                Response = MsgBox("You have entered PON Number " & PON & ". Is this correct?", vbYesNo, "PON Confirmation")
                If Response = vbNo Then   ' If they click the 'no' button - reset PON
                    PON = ""
                End If
            Else                          ' Otherwise explain the entry must only contain numbers
                MsgBox "Sorry, your entry must only contain numbers."
                PON = ""
            End If
        Else                              ' Otherwise explain a PON requires 6 numbers
            MsgBox "Sorry, a PON needs to have 6 numbers."
            PON = ""
        End If
    Loop
    Dim FullPath As String              ' Set a variable for the full path of the current file

    FullPath = ActiveWorkbook.Path      ' Assign the current path to the variable
    
    Set fs = Application.FileSearch     ' Set file search object
    With fs                             ' With the fs object
        .NewSearch                      ' Clear the previous object settings
        .Filename = FullPath & "\" & PON & " test.xls" ' Look for any files named with the entered PON
        .MatchTextExactly = True        ' Ensure an exact match
        If .Execute > 0 Then            ' If the search finds a file with that PON -
                                        ' Send message explaining the file already exists
            MsgBox "Sorry, a file with this name has already been created. Please open the existing file."
                                        ' Close the template without saving
            ActiveWorkbook.Close savechanges:=False
                                        ' Else save the workbook with the New PON as normal
        Else
    
            Do While CODE = ""
                CODE = InputBox("Please enter the CODE of the new batch: ", "Enter CODE") ' Enter product CODE
                If CODE = "" Then
                    MsgBox ("You must enter a product code.") ' Error message for no product code input
                End If
            Loop
            Worksheets("PAP Yield").Activate
            ActiveSheet.Unprotect Password:="Recon"
            Cells(1, 2).Select
            Selection.Locked = False
            Cells(1, 2) = PON  ' Puts value of PON into worksheet
            Selection.Locked = True
            Cells(1, 5).Select
            Selection.Locked = False
            Cells(1, 5) = CODE ' Puts value of CODE into worksheet
            Selection.Locked = True
            Cells(1, 7).Select
            Selection.Locked = False
            Cells(1, 7) = Date ' Enters the date into worksheet
            Selection.Locked = True
            Cells(1, 9).Select
            Selection.Locked = False
            Cells(1, 9) = Time ' Enters the Time into worksheet
            Selection.Locked = True
            Cells(5, 2).Select 'Parks cursor
            ActiveSheet.Protect Password:="Recon"

            ActiveWorkbook.SaveAs (FullPath & "\" & PON & " test.xls")
        End If
    End With
End If

End Sub

 

[BlokeMan]

I'm using v97.

 

[BlokeMan]

what about filesearch subfolders?