Report

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

Ask a question g.cabal 3Posts Thursday June 16, 2016Registration date June 17, 2016 Last seen - Latest answer on Jun 28, 2016 12:00PM
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
moins plus
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 07:03AM
Thanks Mr. TrowaD.
Reply
g.cabal 3Posts Thursday June 16, 2016Registration date June 17, 2016 Last seen - Jun 17, 2016 07:09AM
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.
Reply
TrowaD 1988Posts Sunday September 12, 2010Registration date ModeratorStatus September 19, 2016 Last seen - Jun 20, 2016 11:56AM
Hi G.Cabal,

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

Best regards,
Trowa
Reply
Giezel- Jun 22, 2016 04:49AM
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
Reply
Add comment
Helpful
+0
moins plus
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
Add comment

Members get more answers than anonymous users.

Being a member gives you detailed monitoring of your requests.

Being a member gives you additional options.

Not a member yet?

sign-up, it takes less than a minute and it's free!