Art,
If you are using xl2000 or earlier than there is a limit of ~5460 items
that can be transposed. That means if there are more than that many
lines in any of the text files the code won't work.
Assuming that is the problem, I have modifed the code and show it below.
If it still throws an error then change the line...
"If lngLines < 5460 Then"
-to-
"If lngLines < 1 Then"
If that doesn't work, then I give up. <g>
--
Jim Cone
San Francisco, USA
'----------------
Sub TextFilesToWorksheets()
'Jim Cone - San Francisco, USA
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim objF As Object
Dim strPath As String
Dim strName As String
Dim v As Variant
Dim N As Long
Dim lngLines As Long
Dim lngShtNum As Long
Const ForReading As Long = 1
' Specify the folder...
strPath = "C:\Documents and Settings\user\My Documents\Word & Text Docs"
' Use Microsoft Scripting runtime.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)
' Check type of file in the folder.
For Each objFile In objFolder.Files
If objFile.Name Like "*.txt" Then
strName = objFile.Name
Set objF = objFSO.OpenTextFile(objFile, ForReading)
'Add text to variant array.
v = Split(objF.readall, vbCr) 'vbLf
lngLines = UBound(v) - 1
If lngLines < 5460 Then '<<< New line
'Starts with the first worksheet in workbook
lngShtNum = lngShtNum + 1
With Worksheets(lngShtNum)
.Select
.Range("A1", .Cells(lngLines, 1)).Value = Application.Transpose(v)
.Name = Left$(strName, 30)
End With
Else '<<< New Added Code Follows
lngShtNum = lngShtNum + 1
With Worksheets(lngShtNum)
.Select
For N = 0 To lngLines
.Cells(N + 1, 1).Value = v(N)
Next
.Name = Left$(strName, 30)
End With
End If
End If
Next 'objFile
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
Set objF = Nothing
End Sub
'--------------
"Art MacNeil" <
[email protected]>
wrote in message
Here's the error message:
Automation error:
The object invoked has disconnected from its clients.
