PDA

View Full Version : Retrieve Selected Items from Multiselection List as String



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

Bob Phillips
03-09-2012, 11:46 AM
Don't know why you get all those messages, my simple test worked fine.

On passing the variable, add an argument to the other procedure and oass msg as a parameter in the call.

DJ-DOO
03-13-2012, 06:53 AM
@xld

Thanks for your help..thanks to your input I have this working. :thumb

I have of course come up against another issue. :doh: The documents that I am parsing are 20,000+ words, so on a document this size, my parser is quite slow. If I select the last chapter heading in the document on my checklist it takes between 30-40 seconds to hit, which of course is far far too long..

Can you or anyone have a quick check over my code and see if there might be a more efficient way to carry out this task that would speed up my program??

I hasten to add that I am a third year college student on placement and my first introduction to VB was the week before last. So any help would be really really appreciated....

:help




'================================================================
' POPULATING LIST BOX WITH DATA IN
' CONFIG WORKSHEET
'================================================================

Private Sub ListBox1_Click()

ListBox1.ListFillRange = "Sheet2!A1:A45"

End Sub

'================================================================
' PROCESSING LISTBOX SELECTION
'================================================================
Private 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)
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
ParseDoc msg
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
End If
End Sub


Public Sub ParseDoc(ByVal msg As String)

'======================================================================
' 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
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 = objWord.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
If InStr(1, oPara.Style, "H2") > 0 Then
oPara.Range.Select
MsgBox "You have found the string!"
GoTo CloseDoc
End If
End If
Next oPara

CloseDoc:
oDoc.Close wdDoNotSaveChanges
strFilename = Dir$()
Wend
WordBasic.DisableAutoMacros 0

'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