EXCEL VBA: Application.FileSearch Error in Running Excel 2013 Solved/Closed

Question

Hello everyone, 
I encountered error "Object doesn't support this action"  when i run the macro program after upgrade of excel (from 2003 to 2007).Upon clicking the debug button, 
the highlighted line is "With Application.FileSearch". Here is my codes. 


Sub DataIn()
Dim i As Integer
Dim Shell, myPath
Dim filename As String
Dim ws As Worksheet, flag As Boolean
Dim f_Sheet As Long

' ƒ}ƒNƒ’†’fŽž‚Ì•ªŠòæ‚ÌŽw’è
'    On Error GoTo Š„žˆ—
'    Application.EnableCancelKey = xlErrorHandler
    MaxNo = 1
    
'   ƒtƒHƒ‹ƒ_‚Ì‘I‘ð
    Set Shell = CreateObject("Shell.Application")
    Set myPath = Shell.BrowseForfolder(0&, "ƒf[ƒ^‚ð•Û‘¶‚·‚éƒtƒHƒ‹ƒ_‚ð‘I‚ñ‚Å‚­‚¾‚³‚¢", &H41, ThisWorkbook.Path)
    If Not myPath Is Nothing Then
        If Not myPath.ParentFolder Is Nothing Then
            DataFilePath = myPath.Items.Item.Path
        Else
            Dim objDskTop As Object
            Set objDskTop = CreateObject("WScript.Shell")
            DataFilePath = objDskTop.SpecialFolders("DeskTop")
            Set objDskTop = Nothing
        End If

        With Application.FileSearch
            .LookIn = DataFilePath
            .SearchSubFolders = True
            .filename = "*.txt"
            filename = Dir(DataFilePath & "\" & "*.txt")
            If .Execute() > 0 Then
                'ƒf[ƒ^—pƒV[ƒg
                C_Sheet = Application.ActiveSheet.Name
                tmp1 = Mid$(DataFilePath, InStrRev(DataFilePath, "\") + 1)
                f_Sheet = 0
                For Each ws In Worksheets
                    If ws.Name = tmp1 Then f_Sheet = 1
                Next ws
                If f_Sheet = 1 Then
                    Sheets(tmp1).Select
                    DataCol = 1
                    While (Cells(DataCol, 1) <> "")
                        DataCol = DataCol + 1
                    Wend
                    DataCol = DataCol - 1
                Else
                    Sheets.Add After:=Sheets(C_Sheet)
                    ActiveSheet.Name = tmp1
                    DataCol = 1
                End If
                DataSheet = Application.ActiveSheet.Name
                'ì‹Æ—pƒV[ƒg
                Sheets.Add
                TmpSheet = Application.ActiveSheet.Name

                For i = 1 To .FoundFiles.Count
                    Call ReadData(.FoundFiles(i), DataCol)
                    DataCol = DataCol + 1
                    Sheets(DataSheet).Select
                Next i
                
                ' ŒxƒƒbƒZ[ƒW‚Ì”ñ•\Ž¦iƒV[ƒg‚Ìíœj
                Application.DisplayAlerts = False
                ' ’Ç‰ÁƒV[ƒg‚Ìíœ
                Sheets(TmpSheet).Select
                ActiveWindow.SelectedSheets.Delete
                ' ŒxƒƒbƒZ[ƒW‚Ì•\Ž¦‰ñ•œ
                Application.DisplayAlerts = True
                Sheets(DataSheet).Select
            
                Range(Cells(2, 2), Cells(MaxNo + 1, MaxData)).Select
                
                Selection.Sort Key1:=Range(Cells(2, 4), Cells(2, 4)), Order1:=xlAscending, _
                    Key2:=Range(Cells(2, 3), Cells(2, 3)), Order2:=xlAscending, Header:=xlNo, _
                    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
                Range("A1").Select
            Else
                MsgBox "ƒf[ƒ^ƒtƒ@ƒCƒ‹‚ª‚ ‚è‚Ü‚¹‚ñB"
            End If
        End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Sheets("Main").Select
        If Mid(Range("E12").Value, 1, 3) = "SPC" Then
            If Mid(Range("E12").Value, 5, 4) = "SKEW" Then
                Call copy
            Else
                Call copy2
            End If
        Else
            Call copy3
        End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'MsgBox "*** ˆ—‚ªI‚í‚è‚Ü‚µ‚½B  ***"
    End If
    Exit Sub
    
Š„žˆ—:
    
'   ˆ—’†’f‚Ì“ü—ÍŽž
    If Err = 18 Then
        If MsgBox("ˆ—‚ð’†Ž~‚µ‚Ü‚·‚©H", vbYesNo) = vbNo Then
            Resume
        Else
            End
        End If
    Else
        MsgBox Error(Err)
        End
    End If

End Sub


Appreciate the help from everyone. 
Thank you very much. 
Best regards.

TrowaD · Answer

Hi G.Cabal,

I have no experience with FileSearch, but it seems to be replaced by FindFile in later excel versions.

May the 3rd reply in the link below further guide you:
https://www.mrexcel.com/board/threads/excel-2010-vba-replacement-for-application-filesearch.643288/

Good luck and best regards,
Trowa

TrowaD · Answer

Hi Giezel, Try the code below and see if it yields the desired results. Enter folder path on code line 8. Data from .txt files will be pasted in column A of the active sheet. Sub OpenFiles() Dim MyFolder As String Dim MyFile As String Dim Filename As String Dim cRow As Integer MyFolder = "Folder path here" MyFile = Dir(MyFolder & "\*.txt") cRow = 2 Do While MyFile <> "" Filename = MyFolder & "\" & MyFile Open Filename For Input As #1 Do Until EOF(1) Line Input #1, textline If textline <> vbNullString Then ActiveSheet.Range("A" & cRow).Value = textline End If cRow = cRow + 1 Loop Close #1 MyFile = Dir() Loop End Sub Best regards, Trowa Monday, Tuesday and Thursday are usually the days I'll respond. Bear this in mind when awaiting a reply.

EXCEL VBA: Application.FileSearch Error in Running Excel 2013

2 responses

Subscribe To Our Newsletter!