Word 2003 Macro issue in Word 2010

[ABrown]

Hi - I believe the FileSearch function has been removed from 2010 and a macro I wrote in 2003 no longer works. The macro is based on a form which displays the sub folder names in a txt box called cboChoice and then the files in each sub folder in a list box called ListBox1. The attached code no longer works. I have tried different approaches to this but cannot get it working. Can anyone shed any light on the code attached. Thanks. A


With Application.FileSearch
.NewSearch
.LookIn = fPathSig
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles

If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
frmProvisionBank.ListBox1.AddItem Dir(.FoundFiles(i))
Next i
End If
ListBox1.ListIndex = 0
End With

[Frosty]

Never used Application.FileSearch myself, but it looks like it was removed in Office 2007. Without actually seeing all of your code, this link may help you modify using a different approach.

http://www.word.mvps.org/FAQs/MacrosVBA/ReadFilesIntoArray.htm

Instead of using .AddItem, perhaps a function which returns an array (as a variant), which you can then set your listbox1.List property too (rather than cycling through the array).

However, it's tough to give you an exact solution, because you've got a pretty limited chunk you're showing, and I'm not sure a proof-of-concept better than what is in the link provided would do you any better.

WordBasic.SortArray is one way to sort the results of the array by filename before you pass it to your listcontrol (although it is an old and confusing function). There is not (to my knowledge and a quick google search) a single way to sort arrays in VBA, although there are plenty of examples out there.

[ABrown]

Thanks Frosty - will take a look - for what it is worth I have included all the code for the form:



Public fPathSig
Private Sub cbChoice_Change()
Dim List As Variant
'code from here all works for the list boxes
cmdInsert.Caption = "Create"
ListBox1.Clear
Select Case (cbChoice.Value)
Case "Attorneys Signing"
fPathSig = "J:\House Style\Forms\Attorneys Signing"
cmdInsert.Caption = "Insert"

Case "Companies"
fPathSig = "J:\House Style\Forms\Companies"
cmdInsert.Caption = "Insert"
Case "Individuals and Non-corporte Foreign Entities"
fPathSig = "J:\House Style\Forms\Individuals and Non-corporte Foreign Entities"
cmdInsert.Caption = "Insert"

Case "Miscellaneous"
fPathSig = "J:\House Style\Forms\Miscellaneous"
cmdInsert.Caption = "Insert"

Case "Partnerships"
fPathSig = "J:\House Style\Forms\Partnerships"
cmdInsert.Caption = "Insert"


End Select
frmProvisionBank.Caption = "Provision Bank - Click the file you wish to " & cmdInsert.Caption
With Application.FileSearch
.NewSearch
.LookIn = fPathSig
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles

If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
frmProvisionBank.ListBox1.AddItem Dir(.FoundFiles(i))
Next i
End If
ListBox1.ListIndex = 0
End With

End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Sub cmdInsert_click()
If cbChoice.Value = "Attorneys Signing" Then
Selection.InsertFile FileName:=(fPathSig & "\" & ListBox1.Value)
End If
If cbChoice.Value = "Companies" Then
Selection.InsertFile FileName:=(fPathSig & "\" & ListBox1.Value)
End If
If cbChoice.Value = "Individuals and Non-corporte Foreign Entities" Then
Selection.InsertFile FileName:=(fPathSig & "\" & ListBox1.Value)
End If
If cbChoice.Value = "Miscellaneous" Then
Selection.InsertFile FileName:=(fPathSig & "\" & ListBox1.Value)
End If

If cbChoice.Value = "Partnerships" Then
Selection.InsertFile FileName:=(fPathSig & "\" & ListBox1.Value)
End If
'Else
'
' Documents.Add (fPathSig & "\Forms Documents\" & ListBox1.Value)
'
Unload Me
End Sub
Private Sub ListBox1_Change()
Dim i As Integer
If ListBox1.ListIndex = -1 Then Exit Sub
For i = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(i) = True Then
Image1.Picture = LoadPicture(fPathSig & "\jpg\" & ListBox1.Value & ".jpg")
End If
Next i
End Sub
Private Sub UserForm_Activate()
Dim ObjFso
Dim StrFolderName
Dim ObjFolder
Dim ObjSubFolderCollection
Dim ObjSubFolder
On Error Resume Next
StrFolderName = "J:\House Style\Forms"
Set ObjFso = CreateObject("Scripting.FileSystemObject")
'Getting the folder
Set ObjFolder = ObjFso.GetFolder(StrFolderName)
'Getting the list of sub folders in to a collection object
Set ObjSubFolderCollection = ObjFolder.SubFolders

MsgBox (ObjSubFolderCollection)
'Printing each sub folder in the collection object
For Each ObjSubFolder In ObjSubFolderCollection
'Printing the sub folder name to cbChoice Combo Box
cbChoice.AddItem (ObjSubFolder.Name)
Next
If err.Number <> 0 Then
WScript.Echo ("An error occured.")
End If

End Sub



Thanks for taking the time to look!

Regards.

Annette

[Frosty]

Annette,

There are a lot of things to pick at here in the big picture:
1. You should always always use Option Explicit in every single code module.
2. Name your form controls, don't leave them named as ListBox1 etc
3. Be careful when you use on error resume next just to make an error go away
4. In the following re-write, I left WScript.Echo commented off, as I'm not sure how you're jumping into VBScript, and I wanted the code to work anywhere.

Here's a quick re-write/clean up of your code using the code from the link I provided. It's close enough to the original that it shouldn't be a big leap to understand.


Option Explicit
Private Const FILE_PATH As String = "J:\House Style\Forms"
Public fPathSig As String
Private Sub cbChoice_Change()
Dim i As Integer

'code from here all works for the list boxes
ListBox1.Clear
Select Case (cbChoice.Value)
Case "Attorneys Signing", "Companies", "Miscellaneous", "Partnerships", _
"Individuals and Non-corporte Foreign Entities"
fPathSig = FILE_PATH & "\" & cbChoice.Value
cmdInsert.Caption = "Insert"
Case Else
cmdInsert.Caption = "Create"

End Select

'assuming your form is named frmProvisionBank, use Me instead, whenever referencing the form
'from within the form-- saves headaches later, especially if you don't use Option Explicit
'-- which you should *always* use
Me.Caption = "Provision Bank - Click the file you wish to " & cmdInsert.Caption
'frmProvisionBank.Caption = "Provision Bank - Click the file you wish to " & cmdInsert.Caption
'PopulateList1_Old
PopulateList1_New
End Sub
Private Sub PopulateList1_New()
Dim MyFile As String
Dim Counter As Long

'Create a dynamic array variable, and then declare its initial size
Dim DirectoryListArray() As String
ReDim DirectoryListArray(1000)

'Loop through all the files in the directory by using Dir$ function
MyFile = Dir$(fPathSig & "\*.*")
Do While MyFile <> ""
DirectoryListArray(Counter) = MyFile
MyFile = Dir$
Counter = Counter + 1
Loop

'Reset the size of the array without losing its values by using Redim Preserve
ReDim Preserve DirectoryListArray(Counter - 1)
For Counter = 0 To UBound(DirectoryListArray)
'Debug.Print writes the results to the Immediate window (press Ctrl + G to view it)'
Debug.Print DirectoryListArray(Counter)
Next Counter
ListBox1.List = DirectoryListArray
End Sub
Private Sub PopulateList1_Old()
Dim x As FileSearch
Dim i As Integer

Set x = Application.FileSearch
With x
.NewSearch
.LookIn = fPathSig
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles

If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
Me.ListBox1.AddItem Dir(.FoundFiles(i))
'frmProvisionBank.ListBox1.AddItem Dir(.FoundFiles(i))
Next i
End If
ListBox1.ListIndex = 0
End With
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Sub cmdInsert_click()
Select Case cbChoice.Value
Case "Attorneys Signing", "Companies", "Miscellaneous", "Partnerships", _
"Individuals and Non-corporte Foreign Entities"
Selection.InsertFile FileName:=(fPathSig & "\" & ListBox1.Value)
Case Else
' Documents.Add (fPathSig & "\Forms Documents\" & ListBox1.Value)
End Select
Unload Me
End Sub
Private Sub ListBox1_Change()
Dim i As Integer
If ListBox1.ListIndex = -1 Then
Exit Sub
End If
For i = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(i) = True Then
'what if the graphic doesn't exist?
On Error Resume Next
Image1.Picture = LoadPicture(fPathSig & "\jpg\" & ListBox1.Value & ".jpg")
End If
Next i
End Sub
Private Sub UserForm_Activate()
Dim ObjFso As Object
Dim StrFolderName As String
Dim ObjFolder As Object
Dim ObjSubFolderCollection As Object
Dim ObjSubFolder As Object

On Error Resume Next
'don't need this anymore, since you're using a constant
'StrFolderName = "J:\House Style\Forms"
Set ObjFso = CreateObject("Scripting.FileSystemObject")
'Getting the folder
Set ObjFolder = ObjFso.GetFolder(FILE_PATH)
'Getting the list of sub folders in to a collection object
Set ObjSubFolderCollection = ObjFolder.SubFolders

MsgBox (ObjSubFolderCollection)
'Printing each sub folder in the collection object
For Each ObjSubFolder In ObjSubFolderCollection
'Printing the sub folder name to cbChoice Combo Box
cbChoice.AddItem (ObjSubFolder.Name)
Next
If Err.Number <> 0 Then
'WScript.Echo ("An error occured.")
End If

End Sub


Didn't even need to sort the array, since the Dir function seems to return alpanumeric ascending (which is what you had originally).

Hope this helps.

As an additional note, I see you're already using the FileSystemObject in your Activate event. Why not just continue to use it? I'll post in a bit an example of using the FileSystemObject throughout.

[Frosty]

This would still need error trapping, but it's just a proof of concept. You should be able to use this code in place of the existing form code.

Check out the Locals Window to help understand what is going on with the FileSystemObject (a pretty useful thing to learn about).


Option Explicit
Private Const FILE_PATH As String = "J:\House Style\Forms"
Public fPathSig As String
Private m_oMainFolder As Object
Private Sub cbChoice_Change()
Dim i As Integer

Select Case (cbChoice.Value)
Case "Attorneys Signing", "Companies", "Miscellaneous", "Partnerships", _
"Individuals and Non-corporte Foreign Entities"
fPathSig = FILE_PATH & "\" & cbChoice.Value
cmdInsert.Caption = "Insert"
Case Else
cmdInsert.Caption = "Create"

End Select

Me.Caption = "Provision Bank - Click the file you wish to " & cmdInsert.Caption
PopulateList1_NewNew
End Sub
Private Sub PopulateList1_NewNew()
Dim oFile As Object

On Error Resume Next
ListBox1.Clear
For Each oFile In m_oMainFolder.SubFolders(Me.cbChoice.Value).Files
ListBox1.AddItem oFile.Name
Next
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Sub cmdInsert_click()
Select Case cbChoice.Value
Case "Attorneys Signing", "Companies", "Miscellaneous", "Partnerships", _
"Individuals and Non-corporte Foreign Entities"
Selection.InsertFile FileName:=(fPathSig & "\" & ListBox1.Value)
Case Else
' Documents.Add (fPathSig & "\Forms Documents\" & ListBox1.Value)
End Select
Unload Me
End Sub
Private Sub ListBox1_Change()
Dim i As Integer
If ListBox1.ListIndex = -1 Then
Exit Sub
End If
For i = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(i) = True Then
'what if the graphic doesn't exist?
On Error Resume Next
Image1.Picture = LoadPicture(fPathSig & "\jpg\" & ListBox1.Value & ".jpg")
End If
Next i
End Sub
Private Sub UserForm_Activate()
Dim oSubFolder As Object

'load it into memory
LoadMyFSO

'cycle through the .SubFolders collection and get the names to add to our combo box
For Each oSubFolder In m_oMainFolder.SubFolders
cbChoice.AddItem (oSubFolder.Name)
Next
End Sub
Private Sub LoadMyFSO()
Dim oFSO As Object

On Error Resume Next
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set m_oMainFolder = oFSO.GetFolder(FILE_PATH)

If Err.Number <> 0 Then
'WScript.Echo ("An error occured.")
End If
End Sub

[Frosty]

Slight edit since you don't need to do ListBox1.Clear in the calling routine when you're also doing it in the PopulateList routine.

Couple of other notes:

1. Not sure why you're looping through the listbox and checking the selected item. Since I don't actually know your project (and you weren't using option explicit), I left that code alone. But it looks like you just want to use a picture of whatever file you have selected, but technically if that listbox allowed multi-select, you would load multiple pictures and only the earliest alpanumeric file name would be displayed (so if you had A.txt and B.txt both selected, you would only see A.jpg in Image1).

But the main point is that with this user form, you're displaying a combo-box which has a list of your sub-folders, and then a listbox which (as you change the combo box), lists all the files in the selected sub-folder (fyi, you have a typo in Corporate... it should be easier to rename the folder and fix the code with the above structures).

This form is so simple, and the end result is a single file insert (since you dismiss the form) after a single click... I'm wondering what you're achieving that the native Word Insert File didn't give you?

Something along the lines of:

Sub TestInsertFileNative()
Dim o As Dialog

Set o = Dialogs(wdDialogInsertFile)
o.Name = "J:\House Style\Forms"
o.Show
End Sub

The built-in dialogs collection isn't very well documented, but this link can help.

http://msdn.microsoft.com/en-us/library/aa157603(v=office.10).aspx

[ABrown]

Frosty - thank you soooo much for your help - as you can see I am a real beginner and lots to learn. Do you do this for a living? I may need some paid assistance for a project that I may have to get involved in. If this is of interest please let me know how best to contact you. Thanks Annette

[Frosty]

You're welcome!

Will contact you offlist to provide contact info, but this website also has a consulting arm, and there seem to be a number of good and knowledgeable people on it, so I would expect that there are a lot of people you could pay to get good assistance.

http://www.vbaexpress.com/portal.php