Copiar Nombres de archivos a excel

Otra vez acudiendo a algún experto que pueda darme una mano.
El problema es el siguiente tengo un macro en excel para que dependiendo de la carpeta que contenga archivos de todo tipo pueda copiar los nombres de los mismo en una hoja de excel pero no se porque razón no me muestra los nombres de los archivos. El macro es el siguiente:
Sub ListarArchivosCarpeta()
Dim strArchivos As String
Dim strNombreCarpeta As String
'carpeta donde se hará la búsqueda
strNombreCarpeta = "D:\musica"
'o también se puede hacer la búsqueda en la carpeta donde se encuentra este libro
'strNombreCarpeta = ThisWorkbook.Path
'pasamos al directorio elegido, indicando como tipo de archivo Excel
ChDir strNombreCarpeta
strArchivos = Dir("*.*")
'podemos buscar otro tipo de archivos, por ejemplo .doc, esta es la parte donde tenemos 'que poner la extensión de archivo a buscar o archivos, para mostrar todos los archivos hay 'que poner *.* , excel *.xls, fotos *.jpg - *.gif , etc
strArchivos = Dir("*.*")
'recorremos los archivos de la carpeta
Do While strArchivos <> ""
'podemos mostar el nombre de cada archivo encontrado
'MsgBox strArchivos
'o podemos armar una lista en la hoja Excel
'en este ejemplo comenzará a partir de la celda activa
ActiveCell.Value = strArchivos
ActiveCell.Offset(1, 0).Select
'obtiene la siguiente entrada
strArchivos = Dir
Loop
End Sub