DJ-DOO
03-09-2012, 10:31 AM
Hi,
I have to create a multi selection list (which I've done), populated by a configuration file(which I've also done).
My issue at the moment is, I have to retrieve the selected items as strings (these are chapter names) - search a word doc for those items and then parse everything within that chapter until you come across the next chapter heading, and extract it to an excel doc. (There are both paragraphs and tables within the chapters). Imagine if you could programatically highlight the whole chapter, copy it and paste into the excel doc, that's essentially what I'm after :thumb . The code below is what I've done thus far, I also am wondering about paramaters, as you can see from my list code I'm setting msg to my selection, can I use that in module 1??
Any help would be appreciated, apologies for any rambling.:dunno
When I run this, I get the message box at each line, whether there is text or not, so obviously there is a problem with 'msg'. I don't really think I'm too far off it, I obviously can't attempt my parse until I can identify the chapter heading. If there are multiple selections, I want to hit the first heading, parse, then hit the next selected heading and parse and so on....
************************************************************
'=====================================
' POPULATING LIST BOX WITH DATA IN
' CONFIG WORKSHEET
'=====================================
Private Sub ListBox1_Click()
ListBox1.ListFillRange = "Config!A1:A45"
End Sub
'====================================
' PROCESSING LISTBOX SELECTION
'====================================
Public Sub Parse_Click()
Dim i As Long
Dim msg As String
Dim Check As String
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
msg = msg & .List(i) & vbNewLine
End If
Next i
End With
If msg = vbNullString Then
MsgBox "Nothing Selected!!"
Else
Check = MsgBox("You Selected:" & vbNewLine & msg & vbNewLine & _
"Is This Correct?", _
vbYesNo + vbInformation, "Please Confirm")
If Check = vbYes Then
Call Module1.ParseDoc
Else
'User wants to try again, so clear listbox selections and
'return user to the userform
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = False
Next
End If
=========================================================================== ==========
Public Sub ParseDoc()
'======================================================================
' DECLARING VARIABLES
'======================================================================
Dim ExcelBook As Object
Dim i As Long
Dim oRow As Row
Dim NextRow As Long
Dim oRng As Range
Dim oPara As Paragraph
Dim fDialog As FileDialog
Dim objWord As Word.Application
Dim objExcel As Excel.Application
'Setting Location of Excel Spread for Parsed Details
Const WorkBookName As String = "C:\Users\edoogar\Documents\ParseProject\ParseDetails.xls"
Set objWord = New Word.Application
Set objExcel = New Excel.Application
objExcel.Visible = True
objWord.Visible = True
'=======================================================================
' SETTING UP THE DIALOG BOX
' FOR FILE SELECTION
'=======================================================================
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select Folder to Process and Click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Operation Cancelled", , _
"List Folder Contents"
Unload Form1
Exit Sub
End If
strPath = fDialog.SelectedItems(1)
If Right(strPath, 1) <> "\" _
Then strPath = strPath + "\"
End With
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
If Left(strPath, 1) = Chr(34) Then
strPath = Mid(strPath, 2, Len(srtPath) - 2)
End If
On Error Resume Next
Set ExcelBook = objExcel.Workbooks.Open(Filename:=WorkBookName)
'========================================================================
' SETTING STRFILENAME TO THE FOLDER + .DOC NAME
' EG.."C:\PARSE\REPORT1.DOC..C:\PARSE\REPORT2.DOC ETC...
'========================================================================
strFilename = Dir$(strPath & "*.doc")
'=======================================================================
' OPENS EACH WORD DOCUMENT WITHIN THE SELECTED FILE, PARSES
' THROUGH AND SELECTS THE DATA IN EACH CELL IN THE REFERNCED
' TABLES AND COPIES IT OVER TO THE RELEVANT WORKSHEET IN EXCEL
'=======================================================================
While Len(strFilename) <> 0
WordBasic.DisableAutoMacros 1
Set oDoc = Documents.Open(Filename:=strPath & strFilename, AddToRecentFiles:=False)
'========================================================================
' CHECKING EACH LINE OF DOC FOR LIST BOX ITEM
' DISPLAYING MESSAGE BOX
' (Testing Purposes)
'=========================================================================
For Each oPara In oDoc.Paragraphs
If InStr(1, oPara.Range, msg) > 0 Then
oPara.Range.Select
MsgBox "You have found the string!"
End If
Next oPara
oDoc.Close wdDoNotSaveChanges
WordBasic.DisableAutoMacros 0
strFilename = Dir$()
Wend
'ExcelBook.Close
'objExcel.Quit
objWord.Quit
'========================================================================
' TIDYING UP PROGRAM - SETTING OBJECTS TO NULL
'========================================================================
Set fDialog = Nothing
Set ExcelBook = Nothing
Set oDoc = Nothing
Set oRng = Nothing
End Sub
I have to create a multi selection list (which I've done), populated by a configuration file(which I've also done).
My issue at the moment is, I have to retrieve the selected items as strings (these are chapter names) - search a word doc for those items and then parse everything within that chapter until you come across the next chapter heading, and extract it to an excel doc. (There are both paragraphs and tables within the chapters). Imagine if you could programatically highlight the whole chapter, copy it and paste into the excel doc, that's essentially what I'm after :thumb . The code below is what I've done thus far, I also am wondering about paramaters, as you can see from my list code I'm setting msg to my selection, can I use that in module 1??
Any help would be appreciated, apologies for any rambling.:dunno
When I run this, I get the message box at each line, whether there is text or not, so obviously there is a problem with 'msg'. I don't really think I'm too far off it, I obviously can't attempt my parse until I can identify the chapter heading. If there are multiple selections, I want to hit the first heading, parse, then hit the next selected heading and parse and so on....
************************************************************
'=====================================
' POPULATING LIST BOX WITH DATA IN
' CONFIG WORKSHEET
'=====================================
Private Sub ListBox1_Click()
ListBox1.ListFillRange = "Config!A1:A45"
End Sub
'====================================
' PROCESSING LISTBOX SELECTION
'====================================
Public Sub Parse_Click()
Dim i As Long
Dim msg As String
Dim Check As String
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
msg = msg & .List(i) & vbNewLine
End If
Next i
End With
If msg = vbNullString Then
MsgBox "Nothing Selected!!"
Else
Check = MsgBox("You Selected:" & vbNewLine & msg & vbNewLine & _
"Is This Correct?", _
vbYesNo + vbInformation, "Please Confirm")
If Check = vbYes Then
Call Module1.ParseDoc
Else
'User wants to try again, so clear listbox selections and
'return user to the userform
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = False
Next
End If
=========================================================================== ==========
Public Sub ParseDoc()
'======================================================================
' DECLARING VARIABLES
'======================================================================
Dim ExcelBook As Object
Dim i As Long
Dim oRow As Row
Dim NextRow As Long
Dim oRng As Range
Dim oPara As Paragraph
Dim fDialog As FileDialog
Dim objWord As Word.Application
Dim objExcel As Excel.Application
'Setting Location of Excel Spread for Parsed Details
Const WorkBookName As String = "C:\Users\edoogar\Documents\ParseProject\ParseDetails.xls"
Set objWord = New Word.Application
Set objExcel = New Excel.Application
objExcel.Visible = True
objWord.Visible = True
'=======================================================================
' SETTING UP THE DIALOG BOX
' FOR FILE SELECTION
'=======================================================================
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select Folder to Process and Click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Operation Cancelled", , _
"List Folder Contents"
Unload Form1
Exit Sub
End If
strPath = fDialog.SelectedItems(1)
If Right(strPath, 1) <> "\" _
Then strPath = strPath + "\"
End With
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
If Left(strPath, 1) = Chr(34) Then
strPath = Mid(strPath, 2, Len(srtPath) - 2)
End If
On Error Resume Next
Set ExcelBook = objExcel.Workbooks.Open(Filename:=WorkBookName)
'========================================================================
' SETTING STRFILENAME TO THE FOLDER + .DOC NAME
' EG.."C:\PARSE\REPORT1.DOC..C:\PARSE\REPORT2.DOC ETC...
'========================================================================
strFilename = Dir$(strPath & "*.doc")
'=======================================================================
' OPENS EACH WORD DOCUMENT WITHIN THE SELECTED FILE, PARSES
' THROUGH AND SELECTS THE DATA IN EACH CELL IN THE REFERNCED
' TABLES AND COPIES IT OVER TO THE RELEVANT WORKSHEET IN EXCEL
'=======================================================================
While Len(strFilename) <> 0
WordBasic.DisableAutoMacros 1
Set oDoc = Documents.Open(Filename:=strPath & strFilename, AddToRecentFiles:=False)
'========================================================================
' CHECKING EACH LINE OF DOC FOR LIST BOX ITEM
' DISPLAYING MESSAGE BOX
' (Testing Purposes)
'=========================================================================
For Each oPara In oDoc.Paragraphs
If InStr(1, oPara.Range, msg) > 0 Then
oPara.Range.Select
MsgBox "You have found the string!"
End If
Next oPara
oDoc.Close wdDoNotSaveChanges
WordBasic.DisableAutoMacros 0
strFilename = Dir$()
Wend
'ExcelBook.Close
'objExcel.Quit
objWord.Quit
'========================================================================
' TIDYING UP PROGRAM - SETTING OBJECTS TO NULL
'========================================================================
Set fDialog = Nothing
Set ExcelBook = Nothing
Set oDoc = Nothing
Set oRng = Nothing
End Sub