lkpederson
03-22-2014, 03:05 PM
What the code is *supposed* to do:
1. Search to first occurrence of the word "SUBMITTALS" then
2. Search after that for sentences starting with "RSN ## ## ##-#" where # is a number.
3. Search stops when these statements are loaded into an array. Currently I have the search stopping when it
reaches a style named "_03_CSI TEMPLATE". My thought is that the search is linear i.e. follows the document
word by word thus when it comes to the next occurrence of this style, it should stop. Obviously... not so much.
4. Copy the array into another document
What it's doing:
1. Finding "SUBMITTALS"
2. Copying the first occurrence endlessly into another document.
Any suggestions?
By the bye, I do have a working macro that searches the entire document and returns every occurrence of the above but this
is not what I want. The other occurrences, if they occur elsewhere in a sentence (not the beginning), are unimportant
to the search.
Option Explicit
Function GetFolder(fLoc) As String
Dim oFolder As Object
GetFolder = ""
' Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, fLoc, 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.path
Set oFolder = Nothing
End Function
Sub RSN_FileSrchTableA()
' proggie works but finds all RSN XX XX XX-X in a document instead of stopping in the _
submittals section. still needs fine tuning. NOT WORKING. Currently it _
stays at the same line and keeps copying it instead of looping through.
Dim files ' these are all variant variables and must be converted to strings to use
Dim nDoc As Word.Document
Dim SourceFolder As String, FileFolder As String, pathToPutSaveDoc As String
Dim fLoc As String, AllTogether As String, cRngSplit() As String
Dim cRng As Word.Range
Dim numSentences As Integer, i As Integer
Dim tbl As Table
Set nDoc = Documents.Add
fLoc = "Location of files directory to change?"
SourceFolder = GetFolder(fLoc) & "\"
files = Dir(SourceFolder & "*.doc")
Do While files <> ""
Documents.Open SourceFolder & files
' Sets the variable cRng to include the entire document's contents
' so it can be searched
Set cRng = ActiveDocument.Content
' removes any formatting from the "Find" command
cRng.Find.ClearFormatting
' loop to search for text starting with "RSN" and ending in a period.
With cRng.Find
Application.ScreenUpdating = False
.Forward = True
.Text = "SUBMITTALS"
.Replacement.Text = ""
.MatchCase = True
.Wrap = wdFindStop
.Execute
If .Found Then
cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
Do While .Found
With cRng.Find
.Forward = True
.Text = "RSN ^#^# ^#^# ^#^#-^#,"
.Replacement.Text = ""
.MatchCase = True
.Wrap = wdFindContinue
.Execute
cRng.Expand Unit:=wdParagraph 'Unit:=wdCharacter, use this line copy to a hard return
' cRng.MoveEndUntil Cset:=".", Count:=Word.wdForward ' use this to search _
for a specfic character
' Using split() splits a string. By using the "2", it stops the search at the first _
occurrence. In this case, it stops looking after the first comma.
cRngSplit() = Split(cRng, ",", 2)
' AllTogether = cRngSplit(0) & vbTab & ActiveDocument.Name & _
' vbTab & Trim(Left(cRngSplit(1), Len(cRngSplit(1)) - 1)) & vbCrLf
nDoc.Range.InsertAfter cRng.Text 'AllTogether
cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
If cRng.ParagraphStyle = "_03_CSI TEMPLATE" Then
Exit Do
End If
.Execute
End With
Selection.MoveDown Unit:=wdLine, Count:=2
Loop
End If
End With
' closing the open document before opening another one.
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
files = Dir()
Loop
numSentences = nDoc.Paragraphs.Count
' parse data into a table.
nDoc.Range.Select
Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=3, _
NumRows:=numSentences, AutoFitBehavior:=wdAutoFitFixed
' user selects where to save file
Application.ScreenUpdating = True
fLoc = "Directory to save results?"
pathToPutSaveDoc = GetFolder(fLoc) & "\"
nDoc.SaveAs2 filename:=pathToPutSaveDoc & "RSN.docx"
End Sub
1. Search to first occurrence of the word "SUBMITTALS" then
2. Search after that for sentences starting with "RSN ## ## ##-#" where # is a number.
3. Search stops when these statements are loaded into an array. Currently I have the search stopping when it
reaches a style named "_03_CSI TEMPLATE". My thought is that the search is linear i.e. follows the document
word by word thus when it comes to the next occurrence of this style, it should stop. Obviously... not so much.
4. Copy the array into another document
What it's doing:
1. Finding "SUBMITTALS"
2. Copying the first occurrence endlessly into another document.
Any suggestions?
By the bye, I do have a working macro that searches the entire document and returns every occurrence of the above but this
is not what I want. The other occurrences, if they occur elsewhere in a sentence (not the beginning), are unimportant
to the search.
Option Explicit
Function GetFolder(fLoc) As String
Dim oFolder As Object
GetFolder = ""
' Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, fLoc, 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.path
Set oFolder = Nothing
End Function
Sub RSN_FileSrchTableA()
' proggie works but finds all RSN XX XX XX-X in a document instead of stopping in the _
submittals section. still needs fine tuning. NOT WORKING. Currently it _
stays at the same line and keeps copying it instead of looping through.
Dim files ' these are all variant variables and must be converted to strings to use
Dim nDoc As Word.Document
Dim SourceFolder As String, FileFolder As String, pathToPutSaveDoc As String
Dim fLoc As String, AllTogether As String, cRngSplit() As String
Dim cRng As Word.Range
Dim numSentences As Integer, i As Integer
Dim tbl As Table
Set nDoc = Documents.Add
fLoc = "Location of files directory to change?"
SourceFolder = GetFolder(fLoc) & "\"
files = Dir(SourceFolder & "*.doc")
Do While files <> ""
Documents.Open SourceFolder & files
' Sets the variable cRng to include the entire document's contents
' so it can be searched
Set cRng = ActiveDocument.Content
' removes any formatting from the "Find" command
cRng.Find.ClearFormatting
' loop to search for text starting with "RSN" and ending in a period.
With cRng.Find
Application.ScreenUpdating = False
.Forward = True
.Text = "SUBMITTALS"
.Replacement.Text = ""
.MatchCase = True
.Wrap = wdFindStop
.Execute
If .Found Then
cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
Do While .Found
With cRng.Find
.Forward = True
.Text = "RSN ^#^# ^#^# ^#^#-^#,"
.Replacement.Text = ""
.MatchCase = True
.Wrap = wdFindContinue
.Execute
cRng.Expand Unit:=wdParagraph 'Unit:=wdCharacter, use this line copy to a hard return
' cRng.MoveEndUntil Cset:=".", Count:=Word.wdForward ' use this to search _
for a specfic character
' Using split() splits a string. By using the "2", it stops the search at the first _
occurrence. In this case, it stops looking after the first comma.
cRngSplit() = Split(cRng, ",", 2)
' AllTogether = cRngSplit(0) & vbTab & ActiveDocument.Name & _
' vbTab & Trim(Left(cRngSplit(1), Len(cRngSplit(1)) - 1)) & vbCrLf
nDoc.Range.InsertAfter cRng.Text 'AllTogether
cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd
If cRng.ParagraphStyle = "_03_CSI TEMPLATE" Then
Exit Do
End If
.Execute
End With
Selection.MoveDown Unit:=wdLine, Count:=2
Loop
End If
End With
' closing the open document before opening another one.
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
files = Dir()
Loop
numSentences = nDoc.Paragraphs.Count
' parse data into a table.
nDoc.Range.Select
Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=3, _
NumRows:=numSentences, AutoFitBehavior:=wdAutoFitFixed
' user selects where to save file
Application.ScreenUpdating = True
fLoc = "Directory to save results?"
pathToPutSaveDoc = GetFolder(fLoc) & "\"
nDoc.SaveAs2 filename:=pathToPutSaveDoc & "RSN.docx"
End Sub