Visual Basic - ayuda con selecion multiple commond dialog, por fa

Necesito poder hacer una selecion multiple en el dialogo de apertura, he provado con esto-> cd1.flags = &H200
pero al hacer esto me sale otro common dialog distinto y mas rustico que el normal, que me permite hacer selecciones multiples pero no me coje bien el nombre de los archivos y yo necesito que me los coja exactamente como se llaman ya que voy a mostrar en un listbox los archivos selecionados, sin embargo con este flag me muestra los nombres de archivos incompletos y con simbolos raros ej: ataque~1.mp3 y la cancion se llama: Ataque77 - Porque te vas.mp3
por favor necesito una solucion, muchas gracias x vuestra ayuda ;)

mari: Cuando cambias colocas CD1.Flags= loque sea, estás reescribiendo los flags de commondialog y le quitás el estilo "Explorer", de ahí que te aparezca el cuadro de diálogo al estilo 3.11. A continuación te envío el código para hacerlo funcionar con multiple selección.

Private Sub Command1_Click()
On Error GoTo Salida
Dim S As String, M() As String, K As Long
With CD1
.CancelError = True
.DialogTitle = "Replica de la base de datos"
.Filter = "Archivos de texto (*.txt)|*.txt|Bases de datos Access (*.mdb)|*.mdb|Todos los archivos (*.*)|*.*"
.Flags = cdlOFNExplorer Or cdlOFNAllowMultiselect Or cdlOFNLongNames Or cdlOFNOverwritePrompt Or cdlOFNExplorer
.FileName = ""
.InitDir = CurDir$
.ShowOpen 'Si se presiona cancelar, se produce un error y ya a la etiqueta salida, lo mismo pasa con otros errores, como disco lleno, etc
S = .FileName
M = CnvMultipleSeleccionDeArchivosAUnaMatriz(S)
'La ventana de depuración se abre con Ctrl + G, a veces es necesario estirarla
If UBound(M) = 0 Then
Debug.Print S
Else
For K = LBound(M) To UBound(M)
Debug.Print M(K)
Next K
End If
End With
Exit Sub
Salida:
'Si se cancela, no hay mensajes de error, caso contrario sí
If Err.Number <> cdlCancel Then MsgBox Err.Description
End Sub

la función CnvMultipleSeleccionDeArchivosAUnaMatriz es una que utilizo desde hace mucho. No te olvides que en Windows 9x los nombres de archivos se separan por espacios y era un engorro poder separar los Paths. Estafunción suporta cualquier enorno. en el próximo mensaje te la mando

continuará...

El siguiente código se coloca integramente en un módulo estandar

Option Explicit

Public Enum AtributosEnum
'Atributos De Archivo
FILE_ATTRIBUTE_ARCHIVE = &H20 'Archivo
FILE_ATTRIBUTE_DIRECTORY = &H10 'Directorio
FILE_ATTRIBUTE_NORMAL = &H80 'Sin atributos
FILE_ATTRIBUTE_HIDDEN = &H2 ''Escondido
FILE_ATTRIBUTE_READONLY = &H1 'Solo lectura
FILE_ATTRIBUTE_SYSTEM = &H4 'Sistema
FILE_ATTRIBUTE_TEMPORARY = &H100 'Temporal
FILE_ATTRIBUTE_COMPRESSED = &H800 'Comprimido
FILE_ATTRIBUTE_ENCRYPTED = &H40 'Encriptado
FILE_ATTRIBUTE_SPARSE_FILE = &H200 'Archivo Esparcido (Sólo NT5)
FILE_ATTRIBUTE_REPARSE_POINT = &H400 'Punto de REPARSE File ?????????????? (Sólo NT5)
FILE_ATTRIBUTE_OFFLINE = &H1000 'Fuera de línea. No disponible
End Enum

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type

Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Public Const INVALID_HANDLE_VALUE As Long = -1

Public Function EsUnaMatrizVacia(ByRef Matriz As Variant) As Boolean
On Local Error Resume Next
Dim lng As Long
lng = UBound(Matriz)
EsUnaMatrizVacia = (Err.Number <> 0)
End Function

Public Function ElementosDeLaMatriz(ByRef Matriz As Variant) As Long
On Local Error Resume Next
If EsUnaMatrizVacia(Matriz) = True Then ElementosDeLaMatriz = 0: Exit Function
ElementosDeLaMatriz = (UBound(Matriz) - LBound(Matriz) + 1)
End Function

Public Function EsUnArchivo(ByVal strRuta As String) As Boolean
Dim wData As WIN32_FIND_DATA, hFile As Long
hFile = FindFirstFile(strRuta, wData)
EsUnArchivo = (((wData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) And hFile <> INVALID_HANDLE_VALUE)
FindClose hFile
End Function

Public Function EsUnDirectorio(ByVal strRuta As String) As Boolean
Dim wData As WIN32_FIND_DATA, hFile As Long, f As Boolean
hFile = FindFirstFile(strRuta, wData)
f = (((wData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And hFile <> INVALID_HANDLE_VALUE)
EsUnDirectorio = f
FindClose hFile
End Function

Continúa en el próximo mensaje

Public Function CnvMultipleSeleccionDeArchivosAUnaMatriz(ByVal str As String, Optional ByRef ApiChain As String, Optional ByRef NumElem As Long) As String()
On Error Resume Next
Dim sDir As String, j As Long, K As Long, sFile As String, S() As String, f As Boolean, lS As Long, iIni As Long
Dim T() As String, str2 As String, iPos As Long, SC As String, sx As String, lCount As Long, str3 As String, fRaiz As Boolean
'If Me.TipoDeFileItem(str) <> fieNoExiste Then ReDim T(0) As String: T(0) = str: GoTo Salida
str2 = str
If Right$(str2, 1) = vbNullChar Then str2 = Left$(str, Len(str) - 1)
If Right$(str2, 1) = vbNullChar Then str2 = Left$(str, Len(str) - 1)
iPos = InStr(1, str2, vbNullChar, vbTextCompare)
lCount = -1
If iPos <= 0 Then 'Viejo estilo archivos separados por espacios (Método lento, pero seguro)
iPos = InStrRev(str2, "\", -1, vbTextCompare)
sDir = Left$(str2, iPos)
SC = LTrim$(Mid$(str2, iPos + 1))
S() = Split(SC, " ", -1, vbTextCompare)
str2 = sDir
If Right$(str2, 1) = "\" Then str2 = Left$(str2, Len(str2) - 1)
fRaiz = (Right$(sDir, 1) = "\")
If ElementosDeLaMatriz(S) > 1 Then
lS = UBound(S)
iPos = 0
If fRaiz = False Then
str3 = str2 & "\" & S(0)
For K = 1 To lS
If EsUnDirectorio(str3) Then iPos = K - 1
str3 = str3 & " " & S(K)
Next K
str3 = str2 & "\" & S(0)
If iPos > 0 Then
For K = 1 To iPos
str3 = str3 & " " & S(K)
Next K
End If
sDir = str3
Else

continúa en el próximo mensaje

sDir = str2
iPos = -1
End If
iIni = iPos + 1
str3 = sDir & "\" & S(iIni)
For K = iIni To lS
If EsUnArchivo(str3) = True Then
lCount = lCount + 1
ReDim Preserve T(lCount) As String
T(lCount) = str3
If K < lS Then str3 = sDir & "\" & S(K + 1)
Else
If K < lS Then str3 = str3 & " " & S(K + 1)
End If
Next K
End If
Else 'Nuevo estilo archivos separados por caracteres nulos
S = Split(str, vbNullChar, -1, vbTextCompare)
sDir = S(0)
If Right$(sDir, 1) = "\" Then sDir = Left$(sDir, Len(sDir) - 1)
j = -1
For K = 1 To UBound(S)
S(K) = sDir & "\" & S(K)
If EsUnArchivo(S(K)) = True Then
j = j + 1
ReDim Preserve T(j) As String
T(j) = S(K)
End If
Next K
End If
Salida:
lCount = ElementosDeLaMatriz(T)
If lCount = 0 Then ReDim T(0) As String: T(0) = str
CnvMultipleSeleccionDeArchivosAUnaMatriz = T
If lCount > 0 Then ApiChain = Join(T, vbNullChar) & vbNullChar & vbNullChar Else ApiChain = vbNullChar & vbNullChar
NumElem = lCount
BorrarTodo:
Erase S
Erase T
End Function

continúa en el próximo mensaje ...

Mari: disculpá que haya tenido que dividir la respuesta en tantas partes, pero el número de caracteres que permiten estos mensajes es limitado. Fijate que en el módulo hay varias funciones. En el módulooriginal hay muchas más, en realidad es una dll, así que tuve que adaptarlo. Lo probé y funcioné bien, si no llega a funcionar decime y lo miro.

Espero que te sirva
Saludos Ruri

Muchas gracias ruri, lo voy a mirar y si no me va te lo comento