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