Salida TXT

Tienes que usar el control common dialog de microsoft para que coloques el nombre como lo indicas, checa el siguiente segmento de código y adáptalo como desees...
Option Explicit
Private Sub cmdaceptar_Click()
Dim lRenglon As Long
Dim sDatos As String
Dim sQuery As String
Dim sCotizacion As String
Dim oRS As ADODB.Recordset
Dim iContador As Integer
Dim bHayError As Boolean
Dim iLetra As Integer
Dim sPaso As String
bHayError = False
'----------------------------------------------
' VALIDACIONES PARA REALIZAR LAS CONSULTAS
'----------------------------------------------
If Me.sprCuentas.MaxRows <= 0 Then
MsgBox "Debe realizar la consulta de datos para poder generar el archivo de exportación...", vbCritical, "Error de Proceso"
Me.sprCuentas.SetFocus
Exit Sub
End If
Screen.MousePointer = vbHourglass
'*********************************************************************************************************
cmgDial.FileName = vbNullString
cmgDial.DialogTitle = "Exportación de Datos a INVERLAT"
cmgDial.DefaultExt = "*.txt"
cmgDial.Flags = cdlOFNFileMustExist
cmgDial.Filter = "Texto (*.txt)|*.txt|Todos los archivos(*.*)|*.*"
cmgDial.ShowSave
If cmgDial.FileName = vbNullString Then
Exit Sub
End If
cmgDial.CancelError = True 'Treat the Cancel button as an error
' primero se genera la información del cabecero...
Open cmgDial.FileName For Output As #1
sDatos = vbNullString
' LA CUENTA DESTINO CON UN FORMATO DE 18 CARACTERES (NU 18)
sDatos = sDatos & "EEHAJDF2251765" & Format$(Date, "yyyymmdd") & "001M " & Space(97)
' se graba el registro en el archivo
Print #1, sDatos
sDatos = vbNullString
'recorremos todo el spread para armar el detalle del envio
For lRenglon = 1 To Me.sprCuentas.MaxRows
Me.sprCuentas.Row = lRenglon
Me.sprCuentas.Col = 1
sDatos = vbNullString
sDatos = "EEDAA0100044"
Me.sprCuentas.Col = 3
sDatos = sDatos & Format$(Me.sprCuentas.Text, "00000000000000000000")
sDatos = sDatos & " " & Space(50)
Me.sprCuentas.Col = 4
sDatos = sDatos & Format$(Round(Me.sprCuentas.Value, 0), "00000000000000000")
If lRenglon < Me.sprCuentas.MaxRows Then
sDatos = sDatos & "01"
Else
sDatos = sDatos & "03"
End If
sDatos = sDatos & Space(31)
' se graba el registro en el archivo
Print #1, sDatos
DoEvents
Next lRenglon
sDatos = vbNullString
' LA CUENTA DESTINO CON UN FORMATO DE 18 CARACTERES (NU 18)
sDatos = sDatos & "EETA" & Format$(Me.sprCuentas.MaxRows, "00000000") & "000000000000000000000000" & Space(104)
' se graba el registro en el archivo
Print #1, sDatos
Close #1
Screen.MousePointer = vbDefault
MsgBox "PROCESO DE GENERACION TERMINADO...", vbExclamation, "Exportación de TARJETAS DE VIATICOS"
Exit Sub
error_Grabar:
If Err.Number = 1 Then
' se cancela la selección del archivo a generar
Exit Sub
End If
End Sub
Private Sub cmdcancelar_Click()
Unload Me
End Sub
Private Sub cmdTipo_Click(Index As Integer)
Dim bFileNumber As Byte
Dim sTextLine As String
Dim byTemp As Byte
Dim vcuenta As Variant
Dim iContTemp As Integer
Dim iCuentas As Integer
Dim sPaso As String
Dim sOriginal As String
Dim iInicio As Integer
Dim bTipo As Boolean
Dim lgContRow As Double
Dim giRetorna As Integer
Dim sRegistro As String 'Contenido del Registro
Dim iLongitud As Long
Dim sTmpCadena As String
Dim iLetra As Long
Dim iPos As Long
Dim sLetra As String
Dim sBeneficiario As String
Dim sTipoBenef As String
Dim sRFC As String
Dim cImporte As Currency
On Error GoTo Err_Realiza_Integracion
sprCuentas.MaxRows = 0
'Realiza_Integracion = False
cmgDial.FileName = vbNullString
cmgDial.DialogTitle = "Integración de Datos de Inverlat"
cmgDial.DefaultExt = "*.txt"
cmgDial.Flags = cdlOFNFileMustExist
cmgDial.Filter = "Texto (*.txt)|*.txt|Todos los archivos(*.*)|*.*"
cmgDial.ShowOpen
If cmgDial.FileName = vbNullString Then
Exit Sub
End If
' Si se eligió algún archivo entonces...
Me.Refresh
If Right$(UCase$(cmgDial.FileName), 4) <> ".TXT" Then
MsgBox "El archivo que eligió no es de texto, ¿Desea Continuar?...", vbYesNo + vbQuestion + vbDefaultButton2, " Error "
' If (giRetorna = vbNo) Then
' Exit Sub
' End If
End If
Screen.MousePointer = vbHourglass 'Cambia el apuntador a el reloj de arena para el proceso
bFileNumber = FreeFile ' Obiene un archivo sin usar
Me.txtArchivo.Text = Me.cmgDial.FileName
'Abre el archivo y lee los parámetros
Open cmgDial.FileName For Input As #bFileNumber
lgContRow = 0
iContTemp = 0
Do While Not EOF(bFileNumber) 'Loop until end of file.
Line Input #bFileNumber, sTextLine 'lee la linea y la depósita en una variable
sprCuentas.MaxRows = sprCuentas.MaxRows + 1
sprCuentas.Row = sprCuentas.MaxRows
'lblIntegrados.Caption = "REGISTROS PROCESADOS: " & Format$(sprCuentas.MaxRows, "#,###")
DoEvents
iLongitud = Len(sTextLine)
sTmpCadena = Space$(iLongitud + 100)
iLetra = 1
iPos = 1
For iLetra = 1 To iLongitud
sLetra = Mid$(sTextLine, iLetra, 1)
If Asc(sLetra) = 9 Then
Select Case iPos
Case 1
sBeneficiario = Mid$(sTextLine, 1, iLetra - 1)
Case 2
sTipoBenef = Mid$(sTextLine, Len(sBeneficiario) + 2, (iLetra - Len(sBeneficiario) - 2))
Case 3
sRFC = Mid$(sTextLine, Len(sBeneficiario) + Len(sTipoBenef) + 3, (iLetra - Len(sBeneficiario) - Len(sTipoBenef) - 3))
Exit For
End Select
iPos = iPos + 1
End If
Next
cImporte = Mid$(sTextLine, Len(sBeneficiario) + Len(sTipoBenef) + Len(sRFC) + 3, Len(sTextLine) - (Len(sBeneficiario) + Len(sTipoBenef) + Len(sRFC) + 2))
sprCuentas.Col = 1
sprCuentas.Text = sBeneficiario
sprCuentas.Col = 2
sprCuentas.Text = sTipoBenef
sprCuentas.Col = 3
sprCuentas.Text = sRFC
sprCuentas.Col = 4
sprCuentas.Text = cImporte
Loop
Close #bFileNumber ' Close file.
Screen.MousePointer = vbDefault 'Cambia el apuntador a el reloj de arena para el proceso
'Realiza_Integracion = True
MsgBox "Se termino el proceso de lectura de los Datos", vbOKOnly + vbInformation, "Integración Catálogo TARJETAS DE VIATICOS", giRetorna, False
Exit Sub
Err_Realiza_Integracion:
MsgBox "No se pudo Integrar la Póliza", vbOKOnly + vbInformation, 0, giRetorna, False
Close #bFileNumber ' Close file.
Exit Sub
End Sub
Private Sub Form_Load()
' Me.Height = 6375
' Me.Width = 11160
End Sub