View Single Post
 
Old 01-17-2012, 03:23 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote