long time issue with word doc

[wooonelly]

I am trying to make a macro that would convert the input file to the output file. Please look at the attachments.

The input file will vary in # of pages and sections. The sections will all begin similar to this:

( DIAMETER = 4. )
( CORNER RADIUS = .125 )
( STOCK ALLOWANCE = .03 )

Essentially, I am trying to decrease the number of pages, for reference only. I would like each section to just fill up one page using the first 30 lines, 6 blank lines, and the last 20 lines. I would like the macro to print right away and then close the documents not saving anything.

I have posted regarding this issue in the past but nothing is working and am not referring to those posts because I don't want to confuse anyone.

I do have some code that kinda works and if that will help, let me know. I will post it.

Any help would be appreciated.

[wooonelly]

here is the code I have. It works fine but won't put the last twenty lines of the last section into the output file because it is looking for a "(". This is where I am having my problem.

Sub YoYo()
 
Dim MyFile As Variant
Dim OutputFile As String
Dim count As Integer
Dim LineArray() As String
Dim MyLine As String
Dim arrNum As Long
Dim openfile As Long
Dim temp As String
Dim ALine, DeleteIt, lineNumberAtEnd, Last20Lines As Long
 
On Error GoTo MyErrorHandler:
 
ReDim LineArray(10000000#)             'This redimensions this array...I am assuming there is less than
                                        '10000000 lines between tool sets.
OutputFile = Mid$(CStr(ActiveDocument), 1, Len(ActiveDocument) - 3) & "doc"
Open ActiveDocument For Input As #1
Open OutputFile For Output As #2
 
'Section 1--------------------------------------------------------------------------------------
       
       
       'This first loop gets you past the header info before the first parentheses (
 Line Input #1, MyLine                  'Initialize a line
While InStr(1, MyLine, "%") = 0         'Until you find a ( just keep kicking out lines)
 Print #2, MyLine
 Line Input #1, MyLine
Wend
 
arrNum = 1
 
 If InStr(1, MyLine, "%") <> 0 Then     'The first instance may or may not have lines
  Print #2, MyLine                      'above it...this should be o.k.
  For i = 1 To 30                       'Print 30 lines after the (
   Line Input #1, MyLine
   Print #2, MyLine
  Next i
  
  For i = 1 To 6
  Print #2,
  Next i
  
    Line Input #1, MyLine
    
  
  Do Until InStr(1, MyLine, "(") <> 0   'Until find another (, read lines into array
   LineArray(arrNum) = MyLine
   arrNum = arrNum + 1
   Line Input #1, MyLine
  Loop
  If InStr(1, MyLine, "(") <> 0 Then
   For i = 20 To 1 Step -1
   Print #2, LineArray(arrNum - i)
   Next i
  End If
  ReDim LineArray(10000000#)           'This just empties out the lines in the array
  arrNum = 1
 End If
 
'SECTION 2-----------------------------------------------------------------------------------
            
While InStr(1, MyLine, "(") = 0         'Until you find a ( just keep kicking out lines)
 Print #2, MyLine
Wend
 
arrNum = 1
While Not EOF(1)
 If InStr(1, MyLine, "(") <> 0 Then     'The first instance may or may not have lines
  Print #2, MyLine                      'above it...this should be o.k.
  For i = 1 To 30                       'Print 30 lines after the (
   Line Input #1, MyLine
   Print #2, MyLine
  Next i
  
  For i = 1 To 6
  Print #2,
  Next i
  
  Line Input #1, MyLine
    
  
  Do Until InStr(1, MyLine, "(") <> 0  'Until find another (, read lines into array
   LineArray(arrNum) = MyLine
   arrNum = arrNum + 1
   Line Input #1, MyLine
  Loop
  If InStr(1, MyLine, "(") <> 0 Then
   For i = 20 To 1 Step -1
   Print #2, LineArray(arrNum - i)
   Next i
  End If
End If
Wend
'SECTION 3----------------------------------------------------------------------------------------
 
 
 
Close #1
Close #2
 
UserForm1.Hide
 
MyErrorHandler:
If Err.number = 62 Then
 Close #1
 Close #2
 'Set oDoc = Documents.Open(Path & OutputFile)
'With oDoc
'  .PrintOut
'  .Close SaveChanges:=False
'End With
'Set oDoc = Nothing
End If
 UserForm1.Hide
 
Exit Sub
End Sub