Report

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

Ask a question g.cabal 3Posts Thursday June 16, 2016Registration date June 17, 2016 Last seen - Last answered on Jun 28, 2016 at 12:00 PM by TrowaD
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 
Helpful
+0
plus moins
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
g.cabal 3Posts Thursday June 16, 2016Registration date June 17, 2016 Last seen - Jun 17, 2016 at 07:03 AM
Thanks Mr. TrowaD.
g.cabal 3Posts Thursday June 16, 2016Registration date June 17, 2016 Last seen - 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.
TrowaD 2259Posts Sunday September 12, 2010Registration date ModeratorStatus August 15, 2017 Last seen - 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- 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
Helpful
+0
plus moins
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

Member requests are more likely to be responded to.

Members can monitor the statuses of their requests from their account pages.

A CCM membership gives you access to additional options.

Not a member yet?

Sign up now. It takes less than a minute and is completely free!