|
|
Our Hot Pick: Rising Antivirus 2006 - Certified by TUV & Checkmark! Get 10% discount by entering this coupon code: ONDISCOUNT10
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
|
|
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)
--
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[ at ]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
|
|
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[ at ]rcn.comXXX> wrote in message
news:uSIvZX34GHA.3840[ at ]TK2MSFTNGP06.phx.gbl...
[Quoted Text] > 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) > -- > 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[ at ]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 > > >
|
|
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[ at ]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[ at ]rcn.comXXX>
wrote in message
[Quoted Text] > 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) > -- > 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[ at ]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 |
|
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?
"Jim Cone" <jim.coneXXX[ at ]rcn.comXXX> wrote in message
news:uSIvZX34GHA.3840[ at ]TK2MSFTNGP06.phx.gbl...
[Quoted Text] > 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) > -- > 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[ at ]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 > > >
|
|
Here's the error message:
Automation error:
The object invoked has disconnected from its clients.
"Art MacNeil" <artmacneil[ at ]shaw.ca> wrote in message
news:xHjTg.72643$R63.38678[ at ]pd7urf1no...
[Quoted Text] >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? > > > > > > "Jim Cone" <jim.coneXXX[ at ]rcn.comXXX> wrote in message > news:uSIvZX34GHA.3840[ at ]TK2MSFTNGP06.phx.gbl... >> 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) >> -- >> 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[ at ]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 >> >> >> > >
|
|
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" <artmacneil[ at ]shaw.ca>
wrote in message
Here's the error message:
Automation error:
The object invoked has disconnected from its clients.
|
|
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.
"Jim Cone" <jim.coneXXX[ at ]rcn.comXXX> wrote in message
news:OL6DodD5GHA.696[ at ]TK2MSFTNGP06.phx.gbl...
[Quoted Text] > 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" <artmacneil[ at ]shaw.ca> > wrote in message > Here's the error message: > > Automation error: > The object invoked has disconnected from its clients. > >
|
|
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[ at ]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.
|
|
Thanks Jim.
I'm away for a few days, I'll give this a try when I get back.
Art.
"Jim Cone" <jim.coneXXX[ at ]rcn.comXXX> wrote in message
news:%23xy0qfK5GHA.2144[ at ]TK2MSFTNGP04.phx.gbl...
[Quoted Text] > 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[ at ]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. >
|
|
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.
"Jim Cone" <jim.coneXXX[ at ]rcn.comXXX> wrote in message
news:%23xy0qfK5GHA.2144[ at ]TK2MSFTNGP04.phx.gbl...
[Quoted Text] > 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[ at ]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. >
|
|
Art,
Eight hours of sleep helps me out sometimes. <g>
Jim Cone
"Art MacNeil"
<artmacneil[ at ]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.
|
|
|