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

Posts
3
Registration date
Thursday June 16, 2016
Last seen
June 17, 2016
- Jun 16, 2016 at 01:32 AM - Latest reply:
Posts
2447
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 15, 2018
- Jun 28, 2016 at 12:00 PM
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
' ’ljÁƒ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.
See more 

6 replies

Posts
2447
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 15, 2018
- Jun 16, 2016 at 11:07 AM
0
Thank you
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:
http://www.mrexcel.com/forum/excel-questions/643288-excel-2010-visual-basic-applications-replacement-application-filesearch.html

Good luck and best regards,
Trowa
Posts
3
Registration date
Thursday June 16, 2016
Last seen
June 17, 2016
- Jun 17, 2016 at 07:03 AM
Thanks Mr. TrowaD.
Posts
3
Registration date
Thursday June 16, 2016
Last seen
June 17, 2016
- Jun 17, 2016 at 07:09 AM
Hi TrowaD ,

I already resolved the .FileSearch but my problem is the replace of the code below:

For i = 1 To Application.SelectedItems.Count
Call ReadData(.SelectedItems(i), DataCol)
DataCol = DataCol + 1
Sheets(DataSheet).Select
Next i


Thanks.
Posts
2447
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 15, 2018
- Jun 20, 2016 at 11:56 AM
Hi G.Cabal,

What are you trying to achieve with that piece of code?

Best regards,
Trowa
Giezel >
Posts
2447
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 15, 2018
- Jun 22, 2016 at 04:49 AM
Hello Sir Trowad,

Sorry for late reply.

If .txt file/s are found the content of all text files will copied to the sheet in new sheet name
Posts
2447
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
November 15, 2018
- Jun 28, 2016 at 12:00 PM
0
Thank you
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.