nigelandrewfoster
Well-known Member
- Joined
- May 27, 2009
- Messages
- 747
Good afternoon. I'm a bit stuck again, I'm afraid. Just been coding the routine below. Basically, it creates a listbox of all open workbook names which contain the suffixes listed in the paramarray (or all of them if the first suffix is the wildcard character '*') and stores the user's selections in a Workbook collection. It works fine when the lngPermitted value>1 (and therefore the listbox's MultiSelect value is set to 1) but stops with the error in the title (it also gives the number -2147467259 (80004005)) when lngPermitted value=1 (and the listbox MultiSelect is set to 1). Obviously, lngPermitted is the number of workbooks the user is permitted to select. Does anyone know why?
Thanks for your time.
Thanks for your time.
Code:
Option ExplicitSub Test()
Dim wbOpen As Workbook
Dim wbCollection As New Collection
Dim i As Byte
List_Open_Workbooks wbCollection, 1, "*"
If Not wbCollection Is Nothing Then
For Each wbOpen In wbCollection
MsgBox wbOpen.Name
Next
Else
MsgBox "Not Ok"
End If
End Sub
Sub List_Open_Workbooks(ByRef wbCollection As Collection, lngPermitted As Long, ParamArray strSuffixList() As Variant)
Dim wbOpen As Workbook
Dim wsWorkpad As Worksheet
Dim rngOpenWorkbooks As Range
Dim strFilename As String
Dim strWbSuffix As String
Dim strCaption As String
Dim i As Byte
Dim bytSuffix As Byte
Dim bytWbOpen As Byte
Dim blnSuffixAccepted As Boolean
Dim blnCheckSuffix As Boolean
Set wsWorkpad = ThisWorkbook.Worksheets("Workpad")
If lngPermitted = 1 Then
strCaption = " a workbook"
Else
strCaption = lngPermitted & " workbooks"
End If
With frmWorkbookSelect
.lstWorkbookSelector.MultiSelect = -(lngPermitted > 1)
.Caption = "Please select " & strCaption
End With
blnCheckSuffix = strSuffixList(0) <> "*"
wsWorkpad.[a2:a65535].Delete Shift:=xlUp
For Each wbOpen In Workbooks
If wbOpen.Name <> ThisWorkbook.Name Then
If blnCheckSuffix Then
blnSuffixAccepted = False
strWbSuffix = strSuffix(wbOpen.Name)
For bytSuffix = 0 To UBound(strSuffixList)
If strSuffixList(bytSuffix) = strWbSuffix Then blnSuffixAccepted = True
Next
Else
blnSuffixAccepted = True
End If
If blnSuffixAccepted Then wsWorkpad.[a65535].End(xlUp).Offset(1).Value = wbOpen.Name
End If
Next
If wsWorkpad.[a2].Value <> "" Then
With frmWorkbookSelect
[FONT=arial black] .lstWorkbookSelector.RowSource = "Workpad!A2:" & wsWorkpad.[a65535].End(xlUp).Address[/FONT]
.Show
For i = 0 To .lstWorkbookSelector.ListCount - 1
If .lstWorkbookSelector.Selected(i) Then
bytWbOpen = bytWbOpen + 1
End If
Next
If bytWbOpen = lngPermitted Then
For i = 0 To .lstWorkbookSelector.ListCount - 1
If .lstWorkbookSelector.Selected(i) Then wbCollection.Add Workbooks(.lstWorkbookSelector.Column(0, i))
Next
Else
If bytWbOpen > 0 Then MsgBox "You should have selected " & lngPermitted & " workbooks instead of " & bytWbOpen
End If
End With
End If
End Sub
Function strSuffix(strFilename As String) As String
Dim bytDot As Byte
bytDot = InStrRev(strFilename, ".")
If bytDot > 0 Then strSuffix = Right(strFilename, Len(strFilename) - bytDot)
End Function
Last edited: