Hi Marrick,
Try:
Code:
Private Sub CmdTarget_Click()
Dim TargetFile As Variant, i As Long, StrFiles As String, StrDupes As String
'Create a FileDialog object as a File Picker dialog box.
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
.Filters.Clear
.Filters.Add "All Word Documents", "*.doc; *.dot; *.rtf; *.docx; *.docm; *.dotx; *.dotm", 1
.AllowMultiSelect = True
If .Show = -1 Then
' User clicked OK; show last accessed drive
Label6.Caption = "Most recent target drive: " & Left(.SelectedItems(1), InStrRev(.SelectedItems(1), "\"))
With ListBox3
If .ListCount = 0 Then
.ColumnCount = 2
.ColumnWidths = "0; 60"
i = 0
Else
StrFiles = "|"
For i = 0 To .ListCount - 1
StrFiles = StrFiles & .List(i, 1) & "|"
Next
i = .ListCount - 1
End If
End With
' Populate the listbox
For Each TargetFile In .SelectedItems
If InStr(StrFiles, "|" & Left(TargetFile, InStrRev(TargetFile, "\")) & "|") = 0 Then
ListBox3.AddItem (TargetFile)
ListBox3.Column(1, i) = Split(TargetFile, "\")(UBound(Split(TargetFile, "\"))) 'gets the filename
i = i + 1
Else
StrDupes = StrDupes & vbCr & Left(TargetFile, InStrRev(TargetFile, "\"))
End If
Next
If StrDupes <> "" Then MsgBox "The following files were already selected: " & StrDupes, vbExclamation, "Duplicate Selection"
Call UpdateCounters
End If
End With
End Sub
Also, since you have a checkbox to eliminate potential problem Styles that can occur both in 'All Styles' and 'Styles in Use', your code should deal with both scenarios - at present it only deals with the first of these. Try something like:
Code:
Private Sub PopulateSourceList()
Application.ScreenUpdating = False
'You must OPEN the source document
Dim StrStyExclList As String
StrStyExclList = "|1 / 1.1 / 1.1.1|1 / a / i|Article / Section|" 'identifies styles to exclude from builtin list
CountSourceStyles = 0
If OptAllBltInYes.Value = True Then StyleInd = 1
If OptAllBltInNo.Value = True Then StyleInd = 2
If OptInUse.Value = True Then StyleInd = 3
Select Case StyleInd
Case 1
If ChkFilter.Value = True Then 'get all styles, but filter out problem built-ins
For Each aStyle In ActiveDocument.Styles
If aStyle.BuiltIn = True Then
If aStyle.Type <> wdStyleTypeTable And aStyle.Type <> wdStyleTypeCharacter _
And InStr(StrStyExclList, "|" & aStyle.NameLocal & "|") = 0 Then
ListBox1.AddItem (aStyle.NameLocal)
End If
Else
ListBox1.AddItem (aStyle.NameLocal)
End If
Next aStyle
Else 'get all styles including built-ins
For Each aStyle In ActiveDocument.Styles
ListBox1.AddItem (aStyle.NameLocal)
Next aStyle
End If
Case 2 'get all styles excluding built-ins
For Each aStyle In ActiveDocument.Styles
If aStyle.BuiltIn = False Then
ListBox1.AddItem (aStyle.NameLocal)
End If
Next aStyle
Case 3
If ChkFilter.Value = True Then 'get all styles in use, but filter out problem built-ins
For Each aStyle In ActiveDocument.Styles
If aStyle.BuiltIn = True And aStyle.InUse Then 'get only builtin styles in use
If aStyle.Type <> wdStyleTypeTable And aStyle.Type <> wdStyleTypeCharacter _
And InStr(StrStyExclList, "|" & aStyle.NameLocal & "|") = 0 Then
ListBox1.AddItem (aStyle.NameLocal)
End If
Else
Next
Else
For Each aStyle In ActiveDocument.Styles
If aStyle.InUse Then 'get only styles in use
ListBox1.AddItem (aStyle.NameLocal)
End If
Next aStyle
End If
End Select
Call UpdateCounters
If ListBox1.ListCount = 0 Then MsgBox "There are no applicable styles in the source document."
Application.ScreenUpdating = True
End Sub