Help importing text files into individual cells

[saybut]

Hi,

does anyone know if this is possible... I need to import some text
files into excel but when I use the DATA>Import external data>import
Excel seperates the data into multiple cells.

I need to get it so that when the text file is imported (they aren't
particualry long either, usually just 10-15 short lines), each file
will be in its entirity in a single cell.

I've attached an image incase that isn't particulary clear. I'm not
sure if this is possible to import multiple files like this so may just
have to do it manually.

Many thanks in advance.


+-------------------------------------------------------------------+
|Filename: Text_Import.gif |
|Download: http://www.excelforum.com/attachment.php?postid=3428 |
+-------------------------------------------------------------------+

 

[Dave Peterson]

How about something like this:

Option Explicit
Sub testme01()
Dim resp As Boolean
Dim myNames As Variant
Dim iCtr As Long
Dim oRow As Long
Dim myStr As String

myNames = Array("C:\my documents\excel\test.txt", _
"C:\my documents\excel\test2.txt")

oRow = 0
For iCtr = LBound(myNames) To UBound(myNames)
myStr = ""
resp = DoTheWork(myFileName:=myNames(iCtr), myContents:=myStr)
If resp = True Then
oRow = oRow + 1
ActiveSheet.Cells(oRow, "A").Value = "'" & myStr
Else
MsgBox "something bad happened with: " & myNames(iCtr)
End If
Next iCtr

End Sub
Function DoTheWork(myFileName As Variant, myContents As String) As Boolean

Dim FSO As Object
Dim RegEx As Object
Dim myFile As Object

Set FSO = CreateObject("Scripting.FileSystemObject")

DoTheWork = False
If FSO.fileexists(myFileName) = False Then
'Do nothing
Else
Set myFile = FSO.OpenTextFile(myFileName, 1, False)
myContents = myFile.ReadAll
myFile.Close

Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Global = True
.IgnoreCase = False
.Pattern = Chr(13)
myContents = .Replace(myContents, "")
End With

If Len(myContents) > 32767 Then
'do nothing
Else
DoTheWork = True
End If
End If

End Function


If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

 

[saybut]

Hi Dave, thank you very much for the macro. It wokrs great. I have
another question relating to it, I'm not sure if this is possible but
here goes...

In the macro, I need to list the file names that I want to import

i.e.

myNames = Array("C:\out\OHEC3229.txt", _
"C:\out\OHEC3230.txt", _
"C:\out\OHEC3231.txt")

I need to import around 2,000 text files but VBA editor only lets me
include around 20 names in the format above. I get the error "Too many
line continuations" if I try to insert any more.

Is there a way to include more file names, or is it possible to use
some form of wildcard to say do all the files in that folder that end
in .txt. In dos etc I have used *.txt and this does whatever function
to all the files but I don't know how to apply this kind of thing to a
VBA maco.

thanks again fro the macro, any help with this would be greatly
apprecaited.

Many thanks.

 

[Dave Peterson]

Yep.

How about this:

Option Explicit
Sub testme01()
Dim resp As Boolean
Dim oRow As Long
Dim myStr As String

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String

'change to point at the folder to check
myPath = "C:\my documents\excel\"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.txt")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
oRow = 0
For fCtr = LBound(myNames) To UBound(myNames)
myStr = ""
resp = DoTheWork _
(myFileName:=myPath & myNames(fCtr), myContents:=myStr)
oRow = oRow + 1
ActiveSheet.Cells(oRow, "B").Value = myPath & myNames(fCtr)
If resp = True Then
ActiveSheet.Cells(oRow, "A").Value = "'" & myStr
Else
ActiveSheet.Cells(oRow, "A").Value = "Error"
End If
Next fCtr
End If

End Sub

Function DoTheWork(myFileName As Variant, myContents As String) As Boolean

Dim FSO As Object
Dim RegEx As Object
Dim myFile As Object

Set FSO = CreateObject("Scripting.FileSystemObject")

DoTheWork = False
If FSO.fileexists(myFileName) = False Then
'Do nothing
Else
Set myFile = FSO.OpenTextFile(myFileName, 1, False)
myContents = myFile.ReadAll
myFile.Close

Set RegEx = CreateObject("VBScript.RegExp")
With RegEx
.Global = True
.IgnoreCase = False
.Pattern = Chr(13)
myContents = .Replace(myContents, "")
End With

If Len(myContents) > 32767 Then
'do nothing
Else
DoTheWork = True
End If
End If

End Function

 

[saybut]

That is brilliant Dave, thank you so much!