Aerogal
07-29-2016, 07:28 AM
Hello - I'd greatly appreciate anyone's help. My VBA knowledge is iffy at best. I'm using prior code with some modifications to accomplish my current task at hand. I have a document with special paragraphs. After such paragraphs is: "[SWE-999]" where 999 is any 3 digit number. I'd like to copy each occurrence of these. That is, the [SWE-999] statement and its prior paragraph into an excel spreadsheet. The [SWE-999] statement is typically at the end of the paragraph (with no period after it) but can sometimes be embedded within the paragraph with a list of requirements after it (e.g., "a. XYZ, b. XYZ , c. XYZ). I'm fine copying those in by hand if necessary!
Whenever I run the code, my output spreadsheet contains the page footers that contain hyperlinks (????). What I have thus far is:
Sub FindSWEText()
'
Dim myApp As Object
Dim mySheet As Object
Dim myIndex As Integer
Const Pattern As Variant = "(/[)(*)(/])" 'Find SWE Text
Dim myRange As Range
myIndex = 1
Set myRange = ActiveDocument.Range
With myRange.Find
Do While .Execute(FindText:=Pattern, MatchWildcards:=True)
If .Found Then
myRange.Expand Unit:=wdParagraph
myRange.Copy
myRange.Collapse wdCollapseEnd
If mySheet Is Nothing Then
Set myApp = CreateObject("Excel.Application")
Set mySheet = myApp.workbooks.Open("C:\Users\myname\Desktop\OUTPUT\My_Output").Sheets("Sheet1")
myIndex = 1
End If
mySheet.Cells(myIndex, 1).Select
mySheet.Paste
myIndex = myIndex + 1
If mySheet Is Nothing Then
Set myApp = CreateObject("Excel.Application")
Set mySheet = myApp.workbooks.Open("C:\Users\myname\Desktop\OUTPUT\My_Output").Sheets("Sheet1")
myIndex = 1
End If
End If
Loop
End With
If Not mySheet Is Nothing Then
myApp.workbooks(1).Close True
myApp.Quit
Set mySheet = Nothing
Set myApp = Nothing
End If
Set myRange = Nothing
End Sub
If you have any suggestions, I'd be most appreciative! Thank you!
Whenever I run the code, my output spreadsheet contains the page footers that contain hyperlinks (????). What I have thus far is:
Sub FindSWEText()
'
Dim myApp As Object
Dim mySheet As Object
Dim myIndex As Integer
Const Pattern As Variant = "(/[)(*)(/])" 'Find SWE Text
Dim myRange As Range
myIndex = 1
Set myRange = ActiveDocument.Range
With myRange.Find
Do While .Execute(FindText:=Pattern, MatchWildcards:=True)
If .Found Then
myRange.Expand Unit:=wdParagraph
myRange.Copy
myRange.Collapse wdCollapseEnd
If mySheet Is Nothing Then
Set myApp = CreateObject("Excel.Application")
Set mySheet = myApp.workbooks.Open("C:\Users\myname\Desktop\OUTPUT\My_Output").Sheets("Sheet1")
myIndex = 1
End If
mySheet.Cells(myIndex, 1).Select
mySheet.Paste
myIndex = myIndex + 1
If mySheet Is Nothing Then
Set myApp = CreateObject("Excel.Application")
Set mySheet = myApp.workbooks.Open("C:\Users\myname\Desktop\OUTPUT\My_Output").Sheets("Sheet1")
myIndex = 1
End If
End If
Loop
End With
If Not mySheet Is Nothing Then
myApp.workbooks(1).Close True
myApp.Quit
Set mySheet = Nothing
Set myApp = Nothing
End If
Set myRange = Nothing
End Sub
If you have any suggestions, I'd be most appreciative! Thank you!