This application demonstrates several useful techniques including:

• Loading and saving settings when the application starts and stops.
• Tracking multiple selected directories.
• Managing ListBox choices.
• Quickly listing the files in a directory with API functions.
• Converting long file names to short file names.
• Letting the user browse to select a directory.
• Randomizing an array.
• Generating a list of random files picked from the selected directories.
• Copying files.

When the program starts, it calls its LoadSettings routine. That routine uses GetSetting to loads saved settings. It loads source directory names and their selected state by looping through the setting values Source0, Source1, ... and Selected0, Selected1, ...

Private Sub LoadSettings()
Dim i As Integer
Dim txt As String

    txtDestination.Text = GetSetting(App.ProductName, _
        "Settings", "DestinationDirectory", CurDir)
    txtNumFiles.Text = GetSetting(App.ProductName, _
        "Settings", "NumFiles", "1")

    lstSources.Clear
    For i = 0 To 100
        txt = GetSetting(App.ProductName, "Settings", _
            "Source" & Format$(i), "")
        If Len(txt) < 1 Then Exit For
        lstSources.AddItem txt
        lstSources.Selected(i) = _
            CBool(GetSetting(App.ProductName, "Settings", _
            "Selected" & Format$(i), "False"))
    Next i
End Sub

Next the program uses SaveSetting to save the current settings.

Private Sub SaveSettings()
Dim i As Integer

    On Error Resume Next
    DeleteSetting App.ProductName
    On Error GoTo 0

    SaveSetting App.ProductName, "Settings", _
        "DestinationDirectory", txtDestination.Text
    SaveSetting App.ProductName, "Settings", "NumFiles", _
        txtNumFiles.Text

    For i = 0 To lstSources.ListCount - 1
        SaveSetting App.ProductName, "Settings", "Source" & _
            Format$(i), lstSources.List(i)
        SaveSetting App.ProductName, "Settings", "Selected" _
            & Format$(i), lstSources.Selected(i)
    Next i
End Sub

Private Sub cmdAdd_Click()
    dlgPickFolder.txtDir.Text = CurDir
    dlgPickFolder.Show vbModal
    If Len(dlgPickFolder.txtDir.Text) > 0 Then
        On Error Resume Next
        ChDir dlgPickFolder.txtDir.Text
        If Err.Number <> 0 Then
            MsgBox "Error moving to directory '" & _
                dlgPickFolder.txtDir.Text & "'", _
                vbExclamation Or vbOKOnly, _
                "Directory Error"
        Else
            lstSources.AddItem dlgPickFolder.txtDir.Text
        End If
        On Error GoTo 0
    End If
    Unload dlgPickFolder
End Sub

Private Sub cmdRemove_Click()
Dim i As Integer

    If lstSources.ListCount < 1 Then
        MsgBox "No sources selected to delete", _
            vbInformation Or vbOKOnly, "No Sources Selected"
    ElseIf MsgBox("Delete selected sources?", vbQuestion Or _
        vbYesNo, "Delete Sources?") = vbYes Then
        For i = lstSources.ListCount - 1 To 0 Step -1
            If lstSources.Selected(i) Then
                lstSources.RemoveItem i
            End If
        Next i
    End If
End Sub

' Let the user browse for a directory. Return the
' selected directory. Return an empty string if
' the user cancels.
Public Function BrowseForDirectory(ByVal hwnd As Long) As _
    String
Dim browse_info As BrowseInfo
Dim item As Long
Dim dir_name As String
   
   browse_info.hWndOwner = hwnd
   browse_info.pidlRoot = 0
   browse_info.sDisplayName = Space$(260)
   browse_info.sTitle = "Select Directory"
   browse_info.ulFlags = 1 ' Return directory name.
   browse_info.lpfn = 0
   browse_info.lParam = 0
   browse_info.iImage = 0
   
   item = SHBrowseForFolder(browse_info)
   If item Then
       dir_name = Space$(260)
       If SHGetPathFromIDList(item, dir_name) Then
           BrowseForDirectory = Left(dir_name, _
               InStr(dir_name, Chr$(0)) - 1)
       Else
           BrowseForDirectory = ""
       End If
   End If
End Function

It then makes an array containing the indexes of the files and uss subroutine RandomizeArray to randomize the indexes. Next it uses the indexes to access the files in random order and copies them to the destination directory.

Private Sub cmdLoadFiles_Click()
Dim directories As Collection
Dim file_names As Collection
Dim i As Integer
Dim num_files As Integer
Dim indexes() As Integer
Dim dest_dir As String
Dim files_to_copy As Integer
Dim files_copied As Integer
Dim from_name As String
Dim to_name As String

    ' Make a list of all of the files.
    Set directories = New Collection
    Set file_names = New Collection
    For i = 0 To lstSources.ListCount - 1
        If lstSources.Selected(i) Then
            ListFiles lstSources.List(i), directories, _
                file_names
        End If
    Next i

    ' See how many files we found.
    num_files = file_names.Count
    If num_files < 1 Then
        MsgBox "No files found", vbExclamation Or vbOKOnly, _
            "No Files"
        Exit Sub
    End If

    ' Make the indexes array.
    ReDim indexes(1 To num_files)
    For i = 1 To num_files
        indexes(i) = i
    Next i

    ' Randomize the indexes array.
    RandomizeArray indexes

    ' Grab the first files.
    files_to_copy = CInt(txtNumFiles.Text)
    If files_to_copy > num_files Then files_to_copy = _
        num_files

    ' Start copying files.
    dest_dir = txtDestination.Text
    files_copied = 0
    On Error Resume Next
    For i = 1 To files_to_copy
        from_name = directories(indexes(i)) & "\" & _
            file_names(indexes(i))
        to_name = dest_dir & "\" & file_names(indexes(i))
        FileCopy from_name, to_name
        If Err.Number <> 0 Then
            MsgBox "Error copying file '" & from_name & _
                "' to file '" & to_name & "'" & vbCrLf & _
                Err.Description, _
                vbExclamation Or vbOKOnly, _
                "Copy Error"
            Exit For
        End If
        files_copied = files_copied + 1
'        Debug.Print i & ": FileCopy """ & _
'            directories(indexes(i)) & "\" &
' file_names(indexes(i)) & """, """ & _
'            dest_dir & "\" & file_names(indexes(i)) & """"
    Next i
    On Error GoTo 0

    MsgBox "Copied " & files_copied & " files", _
        vbInformation Or vbOKOnly, "Done"
End Sub

Note that the routine uses the ShortFileName function to convert the file names into the short format required by the file searching API functions.

' List all music files in the directory.
Public Sub ListFiles(ByVal start_dir As String, ByVal _
    directories As Collection, ByVal file_names As _
    Collection)
Dim fname As String
Dim search_handle As Long
Dim file_data As WIN32_FIND_DATA

    start_dir = ShortFileName(start_dir)

    ' Get the first file.
    search_handle = FindFirstFile(start_dir & "\*.mp3", _
        file_data)
    If search_handle <> INVALID_HANDLE_VALUE Then
        ' Get the rest of the files.
        Do
            fname = file_data.cFileName
            fname = Left$(fname, InStr(fname, Chr$(0)) - 1)
            file_names.Add fname
            directories.Add start_dir

            ' Get the next file.
            If FindNextFile(search_handle, file_data) = 0 _
                Then Exit Do
        Loop

        ' Close the file search hanlde.
        FindClose search_handle
    End If
End Sub

' Return the short file name for a long file name.
Public Function ShortFileName(ByVal long_name As String) As _
    String
Dim length As Long
Dim short_name As String

    short_name = Space$(1024)
    length = GetShortPathName( _
        long_name, short_name, _
        Len(short_name))
    If length < 1 Then
        MsgBox "Error converting path '" & _
            long_name & "' into a short name", _
            vbExclamation Or vbOKOnly, "Path Error"
    Else
        ShortFileName = Left$(short_name, length)
    End If
End Function

' Randomize an array of integers indexed from 1.
Public Sub RandomizeArray(indexes() As Integer)
Dim num_items As Integer
Dim i As Integer
Dim j As Integer
Dim tmp As Integer

    ' Randomize the array.
    Randomize
    num_items = UBound(indexes)
    For i = 1 To num_items - 1
        ' Pick a random entry.
        j = Int((num_items - i + 1) * Rnd + i)

        ' Swap the numbers.
        tmp = indexes(i)
        indexes(i) = indexes(j)
        indexes(j) = tmp
    Next i
End Sub