heres what i wrote there: How can I go about extracting certain strings of words in Microsoft Word that are between brackets or {} , along with the brackets or braces , in a folder of word docs and place them line by line in Excel.
the code i have is:
Code: Select all
Sub ExtractText()
Dim xApp As Object
Dim xWbk As Object
Dim xWsh As Object
Dim lRow As Long
Dim bNew As Boolean
Dim sFld As String
Dim sFil As String
Dim cDoc As Document
Dim cRng As Range
' Prompt for folder
With Application.FileDialog(4) 'msoFileDialogFolderPicker
If .Show Then
sFld = .SelectedItems(1) & Application.PathSeparator
Else
Beep
Exit Sub
End If
End With
' Get or start Excel
On Error Resume Next
Set xApp = GetObject(Class:="Excel.Application")
If xApp Is Nothing Then
Set xApp = CreateObject(Class:="Excel.Application")
bNew = True
End If
' Create new workbook with one sheet
xApp.ScreenUpdating = False
Set xWbk = xApp.Workbooks.Add(Template:=-4167) ' xlWBATWorksheet
Set xWsh = xWbk.Worksheets(1)
' Loop through the documents in the folder
sFil = Dir(sFld & "*.doc*")
Do While sFil <> ""
Set cDoc = Documents.Open(FileName:=sFld & sFil, AddToRecentFiles:=False)
Set cRng = cDoc.Content
With cRng.Find
.Text = "\{*\}"
.ClearFormatting
.Replacement.Text = ""
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
Do While .Execute
lRow = lRow + 1
xWsh.Range("A" & lRow).Value = sFil
xWsh.Range("B" & lRow).Value = cRng.Text
Loop
End With
cDoc.Close SaveChanges:=False
sFil = Dir
Loop
xWsh.Range("A1:B1").EntireColumn.AutoFit
xApp.ScreenUpdating = True
If bNew Then
xApp.Visible = True
End If
End Sub
strangely enough, on a diff computer it pulls up excel right away and doesnt do any looping and thats it.