Sub Example()
    Dim s As String
    Dim fso As New FileSystemObject
    Dim fold1 As Folder, fold2 As Folder, fold3 As Folder
    Dim curFile1 As File, curFile2 As File
    Dim s1() As String
    On Error Resume Next
    Set fold1 = fso.GetFolder("c:\Песни\") ' папка где лежат ".mp3"
    Set fold2 = fso.GetFolder("c:\Текст\") ' папка c подпапками где лежат ".txt"
    For Each fold3 In fold2.SubFolders 'пробег по колекции подпапок
        For Each curFile In fold3.Files 'пробег по файлам в подпапке
            s1 = Split(curFile.Name, ".")   ' определение имени без расширения
            s = fold1.Path & "\" & s1( 0 ) & ".mp3" 'создание нужной строки
            Set curFile2 = fso.GetFile(s)   'поиск в папке где лежат ".mp3"
            If Not curFile2 Is Nothing Then ' проверка
                curFile2.Copy (fold3.Path & "\") 'копирование
            End If
            Set curFile2 = Nothing  ' обнуление ссылки
        Next
    Next
    Set fold1 = Nothing ' обнуление ссылки
    Set fold2 = Nothing ' обнуление ссылки
    MsgBox "Готово", vbInformation '
End Sub