Utilizo el código del cuadro diálogo abrir/guardar que tenéis en la guía de recursos.
Sin embargo, para guardar como, selecciono un formato de la lista (por ejemplo, txt) y pongo un nombre de archivo (sin la extensión), y no me almacena en ningún sitio dicha extensión (que yo sepa).
Sólo se almacena el nombre que he introducido.
Por favor, cómo sacar la extensión elegida.

Muchas gracias

Es un error que no he corregido todavia pero en ciertos casos, cuando solo trabajo con una extension, el truco que utilizo es este:

Código:

'Supongamos que la extension es *.DAT:
FileName = DLG_SaveFile(...)

'Compruebo si el usuario ha añadido a mano la extension:
If Not UCase(Right(FileName, 4)) = ".DAT" Then FileName = FileName & ".dat"

El problema esta en si estas trabajando con varias extensiones diferentes ya que este ejemplo solo es util para cuando se trabaja con una sola.

Si tengo tiempo mas adelante intento corregir el error del recurso.

Salu2...

Por lo que me estube fijando, la variable nFilterIndex de la estructura te devuelve el indice seleccionado de la lista (el combo de las extenciones ), el tema es que hay que hacer un par de boludeses porque si seleccionas la primera de la lista la variable vale 1, y te da la extencion correcta, pero si es mayor te da la descripcion, no la extencion,. Debe haber una mejor forma de hacerlo. Te paso una forma, ( depurá un poco la funcion GetExtencionporque es un desastre jeje )

Código:

Private Type OPENFILENAME
 lStructSize As Long
 hwndOwner As Long
 hInstance As Long
 lpstrFilter As String
 lpstrCustomFilter As String
 nMaxCustFilter As Long
 nFilterIndex As Long
 lpstrFile As String
 nMaxFile As Long
 lpstrFileTitle As String
 nMaxFileTitle As Long
 lpstrInitialDir As String
 lpstrTitle As String
 flags As Long
 nFileOffset As Integer
 nFileExtension As Integer
 lpstrDefExt As String
 lCustData As Long
 lpfnHook As Long
 lpTemplateName As String
End Type


Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Dim OFName As OPENFILENAME


Public Function AbrirArchivo(f As Form, extenciones As String, titulo As String) As String
 With OFName
 .lStructSize = Len(OFName)
 .hwndOwner = f.hWnd
 .hInstance = App.hInstance
 .lpstrFilter = extenciones
 .lpstrFile = Space$(254)
 .nMaxFile = 255
 .lpstrFileTitle = Space$(254)
 .nMaxFileTitle = 255
 .lpstrInitialDir = "C:\"
 .lpstrTitle = titulo
 .flags = 0


 If GetOpenFileName(OFName) Then
 AbrirArchivo = Trim$(OFName.lpstrFile)
 Else
 AbrirArchivo = ""
 End If
 End With
End Function


Public Function GuardarComo(f As Form, extenciones As String, titulo As String) As String
 With OFName
 .lStructSize = Len(OFName)
 .hwndOwner = f.hWnd
 .hInstance = App.hInstance
 .lpstrFilter = extenciones
 .lpstrFile = Space$(254)
 .nMaxFile = 255
 .lpstrFileTitle = Space$(254)
 .nMaxFileTitle = 255
 .lpstrInitialDir = "C:\"
 .lpstrTitle = titulo
 .flags = 0
 If GetSaveFileName(OFName) Then
 GuardarComo = Replace(Trim$(.lpstrFile) & GetExtencion(.lpstrFilter, .nFilterIndex), vbNullChar, vbNullString)
 Else
 GuardarComo = ""
 End If
 
 End With
End Function


Private Function GetExtencion(sfilter As String, pos As Long) As String


Dim Ext() As String


Ext = Split(sfilter, vbNullChar)


If pos = 1 And Ext(pos) <> "*.*" Then
 GetExtencion = "." & Replace(Ext(pos), "*.", "")
Exit Function
End If


If pos = 1 And Ext(pos) = "*.*" Then
 GetExtencion = vbNullString
Exit Function
End If


If InStr(Ext(pos + 1), "*.*") Then
 GetExtencion = vbNullString
Else
 GetExtencion = "." & Replace(Ext(pos + 1), "*.", "")
End If
End Function

Efectivamente, EX3, como hasta ahora trabajaba con una extensión no había problemas, pero ahora que uso más vienen las pegas.

Luciano. Gracias por el código, no creo que tenga problemas para depurar lo que dices, jeje.

Muchas gracias a los dos por vuestras aportaciones y rápidas respuestas.

Si no lo has hecho aun subelo a la Guia de Recursos, Luciano

Salu2...

Ahora lo agrego, saludos

Estuve revisando el codigo y parece funcionar correctamente, simplemente te fallo la implementacion de la llamada al cuadro de dialogo ya que te pasa toda la cadena del filtro en un solo elemento y no en varios. Aqui estaria el codigo aplicado a mi implementacion de la Guia de Recursos:

Código:

' Se presupone que estan declaradas las constantes y declaraciones del API de Windows a las que hace referencia el codigo siguiente.

Public Function DLG_SaveFile(hwnd As Long, Filter As String, Title As String, InitDir As String, Optional Filename As String, Optional FilterIndex As Long) As String
 On Local Error Resume Next

 Dim ofn As OPENFILENAME
 Dim a As Long
 
 ofn.lStructSize = Len(ofn)
 ofn.hwndOwner = hwnd
 ofn.hInstance = App.hInstance
 
 If VBA.Right$(Filter, 1) <> "|" Then Filter = Filter + "|"
 
 For a = 1 To Len(Filter)
 If Mid(Filter, a, 1) = "|" Then Mid(Filter, a, 1) = Chr(0)
 Next
 
 ofn.lpstrFilter = Filter
 ofn.lpstrFile = Space(254)
 ofn.nMaxFile = 255
 ofn.lpstrFileTitle = Space(254)
 ofn.nMaxFileTitle = 255
 ofn.lpstrInitialDir = InitDir
 If Not Filename = vbNullString Then ofn.lpstrFile = Filename & Space(254 - Len(Filename))
 ofn.nFilterIndex = FilterIndex
 ofn.lpstrTitle = Title
 ofn.flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_CREATEPROMPT Or OFN_EXPLORER
 a = GetSaveFileName(ofn)

 If a Then
   DLG_SaveFile = Trim$(ofn.lpstrFile)
   If VBA.Right$(Trim$(DLG_SaveFile), 1) = Chr(0) Then DLG_SaveFile = VBA.Left$(Trim$(ofn.lpstrFile), Len(Trim$(ofn.lpstrFile)) - 1) & GetExtension(ofn.lpstrFilter, ofn.nFilterIndex)

 Else
   DLG_SaveFile = vbNullString
   
 End If
 
End Function

Private Function GetExtension(sfilter As String, pos As Long) As String
 Dim Ext() As String
 
 Ext = Split(sfilter, vbNullChar)
 
 If pos = 1 And Ext(pos) <> "*.*" Then
 GetExtension = "." & Replace(Ext(pos), "*.", "")
 Exit Function
 
 End If
 
 If pos = 1 And Ext(pos) = "*.*" Then
 GetExtension = vbNullString
 Exit Function
 
 End If
 
 If InStr(Ext(pos + 1), "*.*") Then
 GetExtension = vbNullString
 
 Else
 GetExtension = "." & Replace(Ext(pos + 1), "*.", "")
 
 End If
 
End Function

Weno, Luciano, te has ganado un puesto en los creditos de proxima version al corregir un ligero bug en la dx_lib32 referente a esta funcion y por quitarme el trabajo de corregirlo yo mismo

Salu2...

P.D.: No subas al final el codigo a la Guia de Recursos, voy actualizar mi implementacion con esta correccion "si es que todavia existe" mi implementacion en la Guia de Recursos. Lo que si podrias es actualizar el codigo en la que tu subistes (o al menos me suena que subistes una hace tiempo)

Ok gracias, pero poneme bien abajo de todo y con letra bien chicaque no me lo meresco jajaja


..si queres borrá el post de la guiaque habia puesto yoasi no esta duplicado


saludos

Iniciado por Luciano

..si queres borrá el post de la guiaque habia puesto yoasi no esta duplicado

Como temia mi implementacion se perdio con la antigua Guia de Recursos asi que he aprovechado para subir un recurso con ambas correcciones, la mia para los filtros y la tuya para la devolucion de la extension seleccionada, todo ello comenzado al principio del texto del recurso

Salu2...

Pues yo lo he solucionado de otro modo.

He sustituido en el modulo la funcion GetExtension por la siguiente:

"Private Function GetExtension(sfilter As String, pos As Long) As String
Dim Ext() As String
Ext = Split(sfilter, vbNullChar)
Form1.Text1.Text = pos

Select Case pos
Case 1
GetExtencion = ".txt"
Case 2
GetExtencion = ".gar"
Case 3
GetExtencion = ".ov2"
Case 4
GetExtencion = ".nav"
Case 5
GetExtencion = ".des"
End Select
End Function"

Es un método quizás un poco menjos genérico pero yo lo veo más claro; lo único que hay que hacer es ir añadiendo extensiones por orden XDD.

Tengo varios tipos de ficheros con la misma extensión y necesito saber dónde se almacena el index del formato elegido al abrir fichero. Gracias.