Previous Topic Next Topic

EXCEL VBA: Application.FileSearch Error in Running Excel 2013

Solved/Closed
g.cabal Posts 3 Registration date Thursday June 16, 2016 Status Member Last seen June 17, 2016 - Jun 16, 2016 at 01:32 AM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - 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.

2 responses

Answer 1 / 2
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Jun 16, 2016 at 11:07 AM
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
0
g.cabal Posts 3 Registration date Thursday June 16, 2016 Status Member Last seen June 17, 2016
Jun 17, 2016 at 07:03 AM
Thanks Mr. TrowaD.
0
g.cabal Posts 3 Registration date Thursday June 16, 2016 Status Member 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.
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Jun 20, 2016 at 11:56 AM
Hi G.Cabal,

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

Best regards,
Trowa
0
Giezel > TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022
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
0
Answer 2 / 2
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Jun 28, 2016 at 12:00 PM
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.
0