Try the following, note you need to include the Microsoft Scripting
Runtime to use FileSystemObject

Option Explicit

' Requires Tools-References Microsoft Scripting Runtime
Public Sub OpenFile()

Dim fsoFileSystemObject As FileSystemObject
Dim strFileName As String
Dim fFile As File
Dim tsTextStream As TextStream
Dim strLine As String
Dim wsNewWorkSheet As Worksheet
Dim lRow As Long

Set fsoFileSystemObject = CreateObject("Scripting.FileSystemObject")
strFileName = Application.GetOpenFilename

If strFileName = "False" Then
MsgBox "Cancelled"
Else
Set fFile = fsoFileSystemObject.GetFile(strFileName)
Set tsTextStream = fFile.OpenAsTextStream(ForReading)
Set wsNewWorkSheet =
Worksheets.Add(After:=Worksheets(Worksheets.Count) )
With wsNewWorkSheet
.Name = "NewSheet"
.Range("A1") = "Company Name"
.Range("A1").Offset(0, 1) = "Address"
.Range("A1").Offset(0, 2) = "Telephone"
.Range("A1").Offset(0, 3) = "Fax"
.Range("A1").Offset(0, 4) = "E-mail"
End With

lRow = 0
Do While Not tsTextStream.AtEndOfStream
lRow = lRow + 1
' Read company name
strLine = tsTextStream.ReadLine
wsNewWorkSheet.Range("A1").Offset(lRow, 0) = strLine
' Read address
strLine = tsTextStream.ReadLine
wsNewWorkSheet.Range("A1").Offset(lRow, 1) = strLine
' Read phone number
strLine = tsTextStream.ReadLine
wsNewWorkSheet.Range("A1").Offset(lRow, 2) = strLine
' Read fax number
strLine = tsTextStream.ReadLine
wsNewWorkSheet.Range("A1").Offset(lRow, 3) = strLine
' Read email address
strLine = tsTextStream.ReadLine
wsNewWorkSheet.Range("A1").Offset(lRow, 4) = strLine
If Not tsTextStream.AtEndOfStream Then tsTextStream.SkipLine
Loop
tsTextStream.Close
End If

End Sub




*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!