PEGAR A LETRA OU CAMINHO UNICO DE ARQUIVO

Citação:

Encontrei uma maneira que é mais fácil do que imaginava
Ao invés de encontra um meio de pegar a letra através do serial
Resolvi gravar o serial e depois fazer uma simples comparação rodando as letras das unidades a procura do Serial gravado com o serial retornado

Para pegar a letra usei este código simples usando FileSystemObject

Dim fso As New FileSystemObject
Dim Winchester As Scripting.Drive

Set Winchester = fso.getdrive([Ô]c[Ô])
Serial =  Hex$(Winchester.SerialNumber)

[ô]Lembrando que para usar FileSystemObject e necesario incluir uma biblioteca do VB
No painel Projeto - Referancias - ative a opçao MICROSOFT SRIPTING RUNTIME

A lista de musicas ficou assim:

SerialdaUnidade+Diretório+Musica

Deste modo não importa em qual sistema eu entre o Serial sempre vai ser o mesmo.
Depois usei o código abaixo para rodar todas as unidade e encontra a letra do Serial gravado no Dir de cada musica

Private Declare Function GetLogicalDriveStrings Lib [Ô]kernel32[Ô] Alias [Ô]GetLogicalDriveStringsA[Ô] _
       (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Function LetraUnidade(Serial As String) As String
Dim pos, ret As Integer
Dim Letra, TodosDrives As String

Dim fso As New FileSystemObject
Dim Winchester As Scripting.Drive

TodosDrives = Space(64)

ret = GetLogicalDriveStrings(Len(TodosDrives), TodosDrives)
TodosDrives = Left$(TodosDrives, ret)

Do
   pos = InStr(TodosDrives, Chr(0))
     If pos Then
        Letra = Left(TodosDrives, pos - 1)
        If Letra <> [Ô]A:\[Ô] And Letra <> [Ô]B:\[Ô] Then [ô]Ignora Disquetes
            TodosDrives = Mid(TodosDrives, pos + 1, Len(TodosDrives))
            Letra = Left(Letra, 1)
            Set Winchester = fso.GetDrive(Letra)
            If Serial = Hex$(Winchester.SerialNumber) Then LetraUnidade = Letra: Exit Function
        End If
    End If
Loop Until TodosDrives = [Ô][Ô]

End Function

Obrigado todos pela atenção.

A maior evolução se da onde não precisamos retornar a idade da pedra.!!!