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
' ƒ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
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
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.
- Posts
- 3
- Registration date
- Thursday June 16, 2016
- Status
- Member
- Last seen
- June 17, 2016
-- Posts
- 3
- Registration date
- Thursday June 16, 2016
- Status
- Member
- Last seen
- June 17, 2016
-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
- 2576
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- December 10, 2019
383 -What are you trying to achieve with that piece of code?
Best regards,
Trowa
- Posts
- 2576
- Registration date
- Sunday September 12, 2010
- Status
- Moderator
- Last seen
- December 10, 2019
-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