Run-time error 445

[BlokeMan]

Hi,

This vba code was done from excel 97 and I'm trying to run in 2007 and got run-time error 445 and highlight Set fs = Application.Filesearch. Is there any solution to get around this?

Private Sub Workbook_Open()
Dim OpenName, PON As String, CODE As String, Response As String, PONMessage As String, MyString As String, DaughterPON As String, DaughterCODE 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 = "Agar Plate Exposure.xls" Then  ' If file is the template

    Do While PON = ""
        PON = InputBox("Please enter the DaughterPON of the new batch: ", "Enter DaughterPON") ' 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 DaughterPON 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                              ' Otherwisw 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 & ".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 DaughterCODE of the new batch: ", "Enter DaughterCODE") ' Enter product CODE
                If CODE = "" Then
                    MsgBox ("You must enter a product code.") ' Error message for no product code input
                End If
            Loop
            Worksheets("AgarExposure").Activate
            ActiveSheet.Unprotect Password:="Polybag"
            Cells(3, 4).Select
            Selection.Locked = False
            Cells(3, 4) = PON ' Puts value of PON into worksheet
            Selection.Locked = True
            Cells(3, 6).Select
            Selection.Locked = False
            Cells(3, 6) = CODE ' Puts value of CODE into worksheet
            Selection.Locked = True
            Cells(1, 9).Select
            Selection.Locked = False
            Cells(1, 9) = Date ' Enters the date into worksheet
            Selection.Locked = True
            Cells(7, 2).Select 'Parks cursor
            ActiveSheet.Protect Password:="Polybag"

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

End Sub

Is there anymore on this code that doesn't support 2007?

Thanks

 

[Trevor G]

FileSearch is no longer support in Office 2007 and above you would have to use Dir commands

Sub Open_My_Files()
Dim MyFile As String
MyPath = "M:\Access Files\"
MyFile = Dir(MyPath)
Do While MyFile <> ""
If MyFile Like "*.xls" Then
Workbooks.Open MyPath & MyFile
Sheets(1).Select
Range("C3") = 6
ActiveWorkbook.Close True
End If
MyFile = Dir
Loop
End Sub

Second sample

Sub mefiles1()
'List files in a folder
F = Dir("m:\Access Files\*.doc")
Range("A1").Activate
Do While Len(F) > 0
ActiveCell.Formula = F
ActiveCell.Offset(1, 0).Select
F = Dir()
Loop