Macro to open text files and copy their contents.

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Art MacNeil - 29 Sep 2006 00:17 GMT

Hi all,

Is there a way for a Macro to open a text file, then copy it's contents to
a spreadsheet and name the tab so it matches the name of the text file?
Then repeat this for 200+ text files in the same folder? I thought I saw a
solution here a while ago but I couldn't find it.

Thanks,

Art

Reply to this Message

Jim Cone - 29 Sep 2006 04:17 GMT

Here is my attempt.
Note:
The help file for the FileSystemObject says that "readall" wastes
memory resources on large files.
There must be sufficient blank sheets in the workbook.
The text added to the worksheet includes some of the line feed characters.
(using Dana DeLouis's idea for the Split function)

Signature

Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

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 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
'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
End If
Next 'objFile

Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
Set objF = Nothing
End Sub
-----------

"Art MacNeil" <artmacneil@shaw.ca>
wrote in message
Hi all,
Is there a way for a Macro to open a text file, then copy it's contents to
a spreadsheet and name the tab so it matches the name of the text file?
Then repeat this for 200+ text files in the same folder? I thought I saw a
solution here a while ago but I couldn't find it.
Thanks,
Art

Reply to this Message

Art MacNeil - 30 Sep 2006 01:35 GMT

Wonderful!!

It worked after I commented out this line '.Range("A1", .Cells(lngLines,
1)).Value = Application.Transpose(v)

Thank you very much for the help with this.

Art.

> Here is my attempt.
> Note:
[quoted text clipped - 3 lines]
> The text added to the worksheet includes some of the line feed characters.
> (using Dana DeLouis's idea for the Split function)

Reply to this Message

Jim Cone - 30 Sep 2006 02:16 GMT

Art,
You are welcome. The feedback is appreciated.
I am curious as to what method you are using to place
the Text file text onto the worksheet?
Jim Cone
San Francisco, USA
http://www.officeletter.com/blink/specialsort.html

"Art MacNeil" <artmacneil@shaw.ca>
wrote in message

Wonderful!!
It worked after I commented out this line '.Range("A1", .Cells(lngLines,
1)).Value = Application.Transpose(v)

Thank you very much for the help with this.
Art.

"Jim Cone" <jim.coneXXX@rcn.comXXX>
wrote in message

> Here is my attempt.
> Note:
[quoted text clipped - 3 lines]
> The text added to the worksheet includes some of the line feed characters.
> (using Dana DeLouis's idea for the Split function)

Reply to this Message

Art MacNeil - 30 Sep 2006 02:24 GMT

I counted my chickens before they had all hatched.

The Macro worked for the first tab - copied the data from the text file and
copied it to the correct tab, but then it didn't copy the rest of the data
from the remaining text files. It did, however, rename the tabs properly.

The part I commented out must be the part that copies the data from the text
file to the remaining tabs.

Any idea how I can get it to work?

> Here is my attempt.
> Note:
[quoted text clipped - 3 lines]
> The text added to the worksheet includes some of the line feed characters.
> (using Dana DeLouis's idea for the Split function)

Reply to this Message

Art MacNeil - 30 Sep 2006 02:27 GMT

Here's the error message:

Automation error:
The object invoked has disconnected from its clients.

>I counted my chickens before they had all hatched.
>
[quoted text clipped - 16 lines]
>> characters.
>> (using Dana DeLouis's idea for the Split function)

Reply to this Message

Jim Cone - 30 Sep 2006 03:23 GMT

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>

Signature

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" <artmacneil@shaw.ca>
wrote in message
Here's the error message:

Automation error:
The object invoked has disconnected from its clients.

Reply to this Message

Art MacNeil - 30 Sep 2006 04:00 GMT

Thanks Jim.

I'm using Excel 2003.

I didn't try "If lngLines < 1 Then" because the Macro really messed up excel

It took a really long time to save a file, then I saw very odd behaviour. I
suspect it was the memory issue. I have 480MB of RAM but I think it wasn't
enough.

I may give it a try at work, where I have more RAM

Thanks again for your efforts.

Art.

> Art,
> If you are using xl2000 or earlier than there is a limit of ~5460 items
[quoted text clipped - 8 lines]
>
> If that doesn't work, then I give up. <g>

Reply to this Message

Jim Cone - 30 Sep 2006 16:48 GMT

Art,
Try this version instead. Hardly any Ram required.
It worked for me on folders with 39 text files.
Note that "Option Compare Text" is added at the very top of
the module. This allows all case versions of ".txt" to be used.
Jim Cone
'-----------

'Next two lines go at top of module.
Option Explicit
Option Compare Text

Sub TextFilesToWorksheets_R2()
'Jim Cone - San Francisco - September 2006
On Error GoTo ThatHurt
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim strPath As String
Dim strName As String
Dim blnTask As Boolean

If Val(Application.Version) >= 10 Then
blnTask = Application.ShowWindowsInTaskbar
Application.ShowWindowsInTaskbar = False
End If
Application.ScreenUpdating = False

' Specify the folder...
strPath = "C:\Program Files\Lavasoft\Ad-aware 6\Logs"

' Use Microsoft Scripting runtime.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strPath)

' Check type of file in the folder and open file.
For Each objFile In objFolder.Files
If objFile.Name Like "*.txt" Then
strName = objFile.Name
Application.StatusBar = strName
Workbooks.Open objFile
ActiveSheet.Name = Left$(strName, 30)
ActiveSheet.Move after:= _
ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
End If
Next 'objFile
CloseOut:
On Error Resume Next
Application.ShowWindowsInTaskbar = blnTask
Application.StatusBar = False
Application.ScreenUpdating = True
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
Exit Sub

ThatHurt:
Beep
MsgBox "Error " & Err.Number & " " & Err.Description, , "Text File Creation"
GoTo CloseOut
End Sub
'-------------

"Art MacNeil" <artmacneil@shaw.ca>
wrote in message
Thanks Jim.
I'm using Excel 2003.
I didn't try "If lngLines < 1 Then" because the Macro really messed up excel
It took a really long time to save a file, then I saw very odd behaviour. I
suspect it was the memory issue. I have 480MB of RAM but I think it wasn't
enough.
I may give it a try at work, where I have more RAM
Thanks again for your efforts.
Art.

Reply to this Message

Art MacNeil - 30 Sep 2006 17:11 GMT

Thanks Jim.

I'm away for a few days, I'll give this a try when I get back.

Art.

> Art,
> Try this version instead. Hardly any Ram required.
[quoted text clipped - 73 lines]
> Thanks again for your efforts.
> Art.

Reply to this Message

Art MacNeil - 30 Sep 2006 17:42 GMT

Curiosity got the better of me.

I tried it and...............it was brilliant!!

I ran the Macro on 268 text files and they are now happily copied to my
spreadsheet/workbook.

Jim, this is a big time saver.

Thank you very much,

Art.

> Art,
> Try this version instead. Hardly any Ram required.
[quoted text clipped - 73 lines]
> Thanks again for your efforts.
> Art.

Reply to this Message

Jim Cone - 30 Sep 2006 18:08 GMT

Art,
Eight hours of sleep helps me out sometimes. <g>
Jim Cone

"Art MacNeil"
<artmacneil@shaw.ca>
wrote in message
Curiosity got the better of me.
I tried it and...............it was brilliant!!
I ran the Macro on 268 text files and they are now happily copied to my
spreadsheet/workbook.
Jim, this is a big time saver.
Thank you very much,
Art.

Reply to this Message

Rate this thread: