Menu
  1. Accueil
  2. Tech Forum
  3. Office Software
  4. Excel

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

Report
Posts
3
Registration date
Thursday June 16, 2016
Status
Member
Last seen
June 17, 2016
 -
Posts
2744
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
May 10, 2021
 -
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.
Related:

2 replies

Answer 1 / 2
Posts
2744
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
May 10, 2021
 461
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
Report
Posts
3
Registration date
Thursday June 16, 2016
Status
Member
Last seen
June 17, 2016
Thanks Mr. TrowaD.
Report
Posts
3
Registration date
Thursday June 16, 2016
Status
Member
Last seen
June 17, 2016
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.
Report
Posts
2744
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
May 10, 2021
 461
Hi G.Cabal,

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

Best regards,
Trowa
Report
>
Posts
2744
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
May 10, 2021
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
Answer 2 / 2
Posts
2744
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
May 10, 2021
 461
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.
Ask a question

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!