word document to excel

groove6270 · Nov 24, 2011

greetings everybody

i have searched the forum for a solution to my problem but no luck.
so, I'm pleading for help.
i have more than 200 pages in doc i need to convert id in a table in excel
here is a sample for only 4 items (entries) (i.e. rows)
I made an excel for the first for to show you what i need
and i hope that is possible
ITEM 1A001: WALL SHELF
Quantity: Two (2)
Manufacturer Custom Fabricate
1. Fabricate in accordance with the General and Specific Conditions of these Specifications, as shown on the drawings and as follows:
a. Shelves shall be sized as shown on drawings approximately 1,732mm long.
b. Provide (1) at 1,372mm above finish floor and (1) at 1,676mm above finish floor. Turn ends up, matching upturned back, weld and polished joints.
c. See Elevation “A” Sheet FSA-6 for additional information.
d. See Standard Detail C-1-2.
ITEM 1A002: RECEIVING TABLE W/ SINK
Quantity: One (1)
Manufacturer Custom Fabricate
1. Fabricate in accordance with the General and Specific Conditions of these Specifications, as shown on the drawings and as follows:
a. Table shall be shaped and sized as detailed on the drawings approximately 1,732mm x 762mm x 914mm high to include: one (1) 508mm x 610mm x 238mm deep sink with one (1) Type 3 Faucet and one (1) Type 2 Drain.
b. Utility drawer at left-side end located as shown on drawings.
c. Full length bottom shelf below.
d. See Elevation “A” Sheet FSA-6 for additional information.
e. See Standard Details C-1-1 (C), C-1-1A (2), C-1-3 and C-7-1.
ITEM 1A003: RECEIVING SCALE
Quantity: One (1)
Manufacturer Fairbanks Scales
Model: SERIES III (18" X 24")

1. Unit to be complete with all standard components and/or accessories including the following:
a. Stainless Steel Mobile Stand.
b. The supplier or manufacturer must submit to the purchaser a list of recommended spare parts as an option along with the equipment offer.
ITEM 1A004: STAND-UP DESK
Quantity: One (1)
Manufacturer Lyon
Model: 2250

1. Unit to be complete with all standard components and/or accessories including the following:
a. 915mm high.
b. The supplier or manufacturer must submit to the purchaser a list of recommended spare parts as an option along with the equipment offer.

[FONT=&quot]

[/FONT][FONT=&quot]

[/FONT]

rosenbe · Nov 24, 2011

If you save your Word document as a text file (insurting line breaks) then try something like this... (this code has not been tested at all and may need modifiaction beyond simply changing the file reference to work, this is meant only as a starting point to solve your issue)

Code:

Sub Upload()
' Declairing Variables.
Dim File As Integer    ' Holds the file Index we are working with
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
' You will need to change this line to reference the text file.
FileName = "C:\...\YourFile.txt"
' Get available file index to use.
File = VBA.FreeFile
' Open our text file.
Open FileName For Input As File
Do Until VBA.EOF(File)
    Line Input #File, MyLine
    MyLine = Application.WorksheetFunction.Trim(MyLine)
    If Strings.UCase$(Strings.Left$(MyLine, 5)) = "ITEM:" Then
        If Not currRow < 1 Then
            ' some code for validation of entries 1 through nth - 1 is 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 If
        currRow = currRow + 1
 
        ' Reset our entry variables
        sItem = vbNullString
        sManufacturer = vbNullString
        sModel = vbNullString
        sDiscription = vbNullString
        sQuantity = vbNullString
 
        Pos = Strings.InStr(MyLine, ":")
        If Pos < 1 Then GoTo BadItem
        sItem = Strings.Mid(MyLine, 6, Pos - 6)
        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, 13)
        sModel = Application.WorksheetFunction.Trim(sModel)
    ' Discription (rest of)
    ElseIf Not MyLine = vbNullString Then
        sDescription = sDescription & MyLine & vbNewLine
    End If
Loop
' 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
Close File
Exit Sub
BadItem:
' Handle bad item exception...
Close File
End Sub

The GetQuantityFromString function is define below:

Code:

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

Hope this helps...

groove6270 · Nov 24, 2011

i saved the doc as plain text with Unicode
and when i tried the code it gave me this error

%20%20Uploaded%20with%20ImageShack.us[/IMG]

thank you very much for your try

rosenbe · Nov 24, 2011

I cannot see the error message...

Though have you tried saving using ASCII?

groove6270 · Nov 24, 2011

saved it in ASCII and try it again this is the result

rosenbe · Nov 24, 2011

Did you copy this function GetQuantityFromString into the sheet code area?

Im my original post, I posted two sets of code, the Upload sub and the GetQuantityFromString, the Upload sub requires the additional function. I posted it under two separate code blocks in an attempt to make it easier to read. Sorry if that caused confusion.

groove6270 · Nov 25, 2011

obviously i'm doing something wrong
now it gave this error

http://imageshack.us

rosenbe · Nov 25, 2011

Try explicitly calling the ranges.

Code:

ThisWorkbook.Sheets("YourSheetName").Range...

It sounds like it may be a referencing issue as I don't believe there is a Range method.

groove6270 · Nov 25, 2011

where to to put that code

rosenbe · Nov 25, 2011

Try this, make sure to update the FileName and SheetName lines that are surrounded by Astrix (*).

Code:

Sub Upload()
' Declairing Variables.
Dim File As Integer    ' Holds the file Index we are working with
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 sSheetName As String

'****************************************************************
' You will need to change these lines to reference the text file and sheet you are using
FileName = "C:\...\YourFile.txt"
SheetName = "Sheet1"
'****************************************************************

' Get available file index to use.
File = VBA.FreeFile
' Open our text file.
Open FileName For Input As File
Do Until VBA.EOF(File)
    Line Input #File, MyLine
    MyLine = Application.WorksheetFunction.Trim(MyLine)
    If Strings.UCase$(Strings.Left$(MyLine, 5)) = "ITEM:" Then
        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
 
        Pos = Strings.InStr(MyLine, ":")
        If Pos < 1 Then GoTo BadItem
        sItem = Strings.Mid(MyLine, 6, Pos - 6)
        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, 13)
        sModel = Application.WorksheetFunction.Trim(sModel)
    ' Discription (rest of)
    ElseIf Not MyLine = vbNullString Then
        sDescription = sDescription & 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
Close File
Exit Sub
BadItem:
' Handle bad item exception...
Close File
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

word document to excel

groove6270

New Member

Excel Facts

rosenbe

Board Regular

groove6270

New Member

rosenbe

Board Regular

groove6270

New Member

rosenbe

Board Regular

groove6270

New Member

rosenbe

Board Regular

groove6270

New Member

rosenbe

Board Regular

Similar threads

Forum statistics

Share this page

word document to excel

New Member

Excel Facts

Board Regular

New Member

Board Regular

New Member

Board Regular

New Member

Board Regular

New Member

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock