Again: word document to excel

[groove6270]

Hi
i have this word document with repetition pattern i need to convert it to excel. i had this problem before and it was solved by rosenbe here
http://www.mrexcel.com/forum/showthread.php?t=594601
and now i have very much similar file need converting the same way, so i tried to alternate the code given by rosenbe but no use. can someone help me here?
here is a snap shot to the word doc



and here is a sample of how i need it



last time this code did it

Sub Upload()
' Declairing Variables.
Dim FileName As String ' Holds the name of the file we are working with
Dim MyLine As String ' Holds the line we just read from our file
Dim currRow As Long ' Holds the current row we are inputting to.
Dim Pos As Long ' The position of something in a string
Dim sItem As String
Dim sManufacturer As String
Dim sModel As String
Dim sDiscription As String
Dim sQuantity As String
Dim SheetName As String
Dim oFSO As New Scripting.FileSystemObject ' Requires reference to Microsoft Scripting Runtime
Dim oFile As Scripting.TextStream ' Requires reference to Microsoft Scripting Runtime
'****************************************************************
FileName = "C:\4.txt" ' The file we will be uploading
SheetName = "Sheet1" ' The sheet we will upload to
currRow = 1 ' The starting line - 1
'****************************************************************
' Open our text file.
On Error GoTo FailedToOpen
Set oFile = oFSO.OpenTextFile(FileName, ForReading)
Do While Not oFile.AtEndOfStream
MyLine = oFile.ReadLine ' Get the next line
MyLine = Application.WorksheetFunction.Trim(MyLine) ' Remove any extra spaces
MyLine = Application.WorksheetFunction.Clean(MyLine) ' Remove any non-diplayable characters
If Strings.UCase$(Strings.Left$(MyLine, 4)) = "ITEM" Then
Pos = Strings.InStr(MyLine, ":")
If Pos < 1 Then GoTo BadItem
If Not currRow < 1 Then
' some code for validation of entries 1 through nth - 1 is needed?
With ThisWorkbook.Sheets(SheetName)
.Range("A" & currRow).Value = sItem
.Range("B" & currRow).Value = sManufacturer
.Range("C" & currRow).Value = sModel
.Range("D" & currRow).Value = sDiscription
.Range("E" & currRow).Value = sQuantity
End With
End If
currRow = currRow + 1

' Reset our entry variables
sItem = vbNullString
sManufacturer = vbNullString
sModel = vbNullString
sDiscription = vbNullString
sQuantity = vbNullString

sItem = Strings.Mid(MyLine, 6, Pos - 6)

' Fix for 1EXXX converting to a number
sItem = "=""" & sItem & """"

sDiscription = Application.WorksheetFunction.Trim( _
Strings.Right$( _
MyLine, _
Strings.Len(MyLine) - Pos _
) _
) & vbNewLine
' Quantity
ElseIf Strings.UCase(Strings.Left$(MyLine, 9)) = "QUANTITY:" Then
sQuantity = GetQuantityFromString(MyLine)

' Manufacturer
ElseIf Strings.UCase(Strings.Left$(MyLine, 12)) = "MANUFACTURER" Then
sManufacturer = Strings.Mid$(MyLine, 13)
sManufacturer = Application.WorksheetFunction.Trim(sManufacturer)

' Model
ElseIf Strings.UCase(Strings.Left$(MyLine, 6)) = "MODEL:" Then
sModel = Strings.Mid$(MyLine, 7)
sModel = Application.WorksheetFunction.Trim(sModel)
' Discription (rest of)
ElseIf Not MyLine = vbNullString Then
BadItem:
sDiscription = sDiscription & MyLine & vbNewLine
End If
Loop

With ThisWorkbook.Sheets(SheetName)
' some code for validation of the final (nth) entry needed?
.Range("A" & currRow).Value = sItem
.Range("B" & currRow).Value = sManufacturer
.Range("C" & currRow).Value = sModel
.Range("D" & currRow).Value = sDiscription
.Range("E" & currRow).Value = sQuantity
End With

FailedToOpen:
oFile.Close
Set oFile = Nothing
Set oFSO = Nothing
End Sub

Private Function GetQuantityFromString(ByRef sQuantity As String) As String
Dim result As String
Dim i As Long
Dim b As Boolean

For i = 1 To Strings.Len(sQuantity)
If Strings.Mid$(sQuantity, i, 1) = ")" Then GoTo NumberFound
If b Then result = result & Strings.Mid$(sQuantity, i, 1)
If Strings.Mid$(sQuantity, i, 1) = "(" Then
b = True
End If
Next i

NumberFound:
GetQuantityFromString = result
End Function

no matter what i try, it fails
please help

 

[groove6270]

guys please help