Bajar varios archivos TXT a partir de una consulta

Jorge: Veamos si resumido solucionas el problema, y en caso de no ser así te pondría aquí en un enlce un fichero. No lo hago ahora porque he de separar las pruebas de una BBDD más amplia y que tengo datos personales.

He creado una Tabla con los campos:

Codigo (AutoNum), Grupo (Num) que sería equivalente a tu Inventario.

5 Campos de Texto de F1 ... aF5

En un Módulo Estandar he puesto éste código. Puede estar en el Formulario.

Option Compare Database
Option Explicit
Sub ExportaPorGrupo()
Dim QryGrupos As String, QryDetall As String
Dim RstGrupos As DAO.Recordset, RstDetall As DAO.Recordset
Dim RutaTxt As String
Dim ElFichero As String
Dim LinText As String
Dim NumLinea As Long
QryGrupos = "SELECT Grupo FROM TDatos GROUP BY Grupo ORDER BY Grupo;"
Set RstGrupos = CurrentDB.OpenRecordset(QryGrupos)
RstGrupos.MoveLast
RstGrupos.MoveFirst
Do Until RstGrupos.EOF
        NumLinea = 0
        QryDetall = "SELECT Codigo, Grupo, F1, F2, F3, F4, F5 FROM TDatos WHERE Grupo = " & RstGrupos!Grupo
        Set RstDetall = CurrentDB.OpenRecordset(QryDetall)
        RstDetall.MoveLast
        RstDetall.MoveFirst
        RutaTxt = Application.CurrentProject.Path
        ElFichero = "\FSalida" & Format(RstGrupos!Grupo, "00") & ".txt"
        Open RutaTxt & ElFichero For Output As #1   'Crea el Fichero si no existe
        'Print #1, LinText
        With RstDetall
                Do Until .EOF
                        LinText = Space(5) & (RstDetall!Codigo) & Space(2) & (RstDetall!Grupo) & Space(3) & (RstDetall!F1) & Space(3) & (RstDetall!F2) & Space(3) & (RstDetall!F3) & Space(3) & (RstDetall!F4) & Space(5) & (RstDetall!F5)
                        NumLinea = NumLinea + 1
                        Print #1, LinText  'Sai
                        .MoveNext
                Loop
        End With
        Close #1
        RstGrupos.MoveNext
Loop
Set RstGrupos = Nothing
Set RstDetall = Nothing
MsgBox "Creados todos los Ficheros de Texto según Grupo...", vbInformation, "Exemplo Access"
End Sub

En la Tabla hay 3 Grupos de modo que genera 3 Ficheros .txt >> FSalida01....al 03

Para llamar a ese procedimiento desde donde tu quieras >> Call ExportaPorGrupo

La tabla se llama TDatos

Dime si tienes dificultades y si fuera así segrego esa parte de la BBDD y te la pongo aquí en un enlace>> Saludos >> JTJ

Jacinto: Es verdaderamente genial. Lo adapte a lo que necesito y me funciona muy bien.

Tengo una consulta: Me gustaría agregar esto a una base de datos que me arroja varios reportes juntos.

Esta base de datos tiene un modulo que me permite elegir la ruta donde quiero que me guarde los archivos. El modulo creo que me lo pasaste vos en su momento: "Elección Ruta" Public Function fncSelectCarpeta

Si reemplazo la linea del código:  "RutaTxt = Application.CurrentProject.Path"  por el nombre de la funcion fncSelectCarpeta, podría funcionar?

O en tal caso como podría hacer para que junto al resto de los reportes me baje los archivos TXT en la carpeta que elegí?

Desde ya muchísimas gracias por tu ayuda verdaderamente útil.

Saludos. Jorge

Jorge: Sinceramente ahora no recuerdo cuando te facilité ese código, pero si eliges la carpeta y capturas su valor como un String, no debería darte problemas.

Si tienes dificultades me comentas, citando el código que usas. Saludos >> JTJ

Jacinto: Verificando, es verdad,  me lo envió el experto Sveinbjorn El Rojo.

El tema es que hago el reemplazo en la linea de código "Ruta Txt" por el Nombre de la función que me elije la carpeta, me pide nuevamente que seleccione la carpeta donde quiero que descargue el fichero TXT.

La verdad estoy aprendiendo día a día pero no se como capturar el valor. imagino que en una variable Dim.

En la función que tengo y describo a continuación, la variable se llama "rutaIni" pero no se como capturarla desde la función que me pasaste.

Me ayudarías por favor?

Esta función la tengo en un modulo:

Public Function fncSelectCarpeta() As String
'Creamos un control de errores
On Error GoTo sol_err
'Declaramos las variables
Dim fd As Object 'fd = FileDialog
Dim rutaIni As String
'Definimos la ruta inicial
rutaIni = Application.CurrentProject.Path
'Creamos el objeto FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
'Configuramos las características de nuestra ventana de diálogo
With fd
.Title = "Selecciona la carpeta"
.ButtonName = "Aceptar"
.InitialView = msoFileDialogViewList
.InitialFileName = rutaIni
'Detectamos el botón pulsado por el usuario
If .Show = -1 Then
'Asignamos a la función la carpeta seleccionada, convirtiéndola
'a un valor de tipo String
fncSelectCarpeta = CStr(.SelectedItems.item(1))
Else
'Si se pulsa cancelar avisamos y salimos
MsgBox "Selección cancelada", vbExclamation, "CANCELADO"
Exit Function
End If
End With
Salida:
Exit Function
sol_err:
MsgBox "Se ha producido el error: " & Err.Number & " - " & Err.Description
Resume Salida
End Function

Muchas gracias

Jorge