Exportar e Importar

Esto lo tienes que hacer con un recordset de lectura de la información y con el método open. Checa la siguiente rutina y adáptala:
Open mdiPrincipal.dlgGeneralMDI.FileName For Output As #1
'Ejecutamos query
If (ObtieneDatos(1, 1)) Then
' Se genera el archivo con los datos de los documentos normales de bancomer
' DATOS DE PROVEEDORES
' se recorre el recordset de datos de documentos por depositar
Do While Not grs_Recordset.EOF
sDatos = vbNullString
' LA CUENTA DESTINO CON UN FORMATO DE 18 CARACTERES (NU 18)
If Not IsNull(grs_Recordset.Fields(0)) Then
sDatos = sDatos & Format$(Trim$(grs_Recordset.Fields(0)), "000000000000000000")
Else
sDatos = sDatos & "000000000000000000"
End If
' EL TIPO DE MONEDA ( MXP ) FIJO SIEMPRE
sDatos = sDatos & "MXP"
' El importe o monto de acuerdo si es neto o normal formateado con ceros a la izquierda (mo 16)
If Not IsNull(grs_Recordset.Fields(1)) Then
If Val(grs_Recordset.Fields(2)) = 0 Then
' SE TRATA DE UN IMPORTE NORMAL
sDatos = sDatos & Format$(Val(grs_Recordset.Fields(1)), "0000000000000.00")
Else
' SE TRATA DE UN IMPORTE NETO
If Not IsNull(grs_Recordset.Fields(2)) Then
sDatos = sDatos & Format$(Val(grs_Recordset.Fields(2)), "0000000000000.00")
Else
sDatos = sDatos & "0000000000000000"
End If
End If
Else
' SE TRATA DE UN IMPORTE NETO
If Not IsNull(grs_Recordset.Fields(2)) Then
sDatos = sDatos & Format$(Val(grs_Recordset.Fields(2)), "0000000000000000")
Else
sDatos = sDatos & "0000000000000000"
End If
End If
' LA CUENTA DE ORIGEN SELECCIONADA CON FORMATO (NU 18)
sDatos = sDatos & Format$(Trim$(itxCtaCheques.Text), "000000000000000000")
' sDatos = sDatos & Format$(Trim$("11" & itxCtaCheques.Text), "000000000000000000")
' La referencia del documento a transferir con un formato (al 30) y espacios en la izquierda
If Not IsNull(grs_Recordset.Fields(3)) Then
sDatos = sDatos & Ajusta_Texto(Trim$(grs_Recordset.Fields(3)))
Else
sDatos = sDatos & " "
End If
' se graba el registro en el archivo
Print #1, sDatos
grs_Recordset.MoveNext
Loop
'*********************************************************************
' DATOS DE EMPLEADOS
If (ObtieneDatos(1, 2)) Then
' se genera el archivo con los datos de los documentos normales de bancomer
' DATOS DE EMPLEADOS
' se recorre el recordset de datos de documentos por depositar
Do While Not grs_Recordset.EOF
sDatos = vbNullString
sCuentaRecursos = vbNullString
' se revisa la cuenta del empleado en las altas
sQueryRecursos = "SELECT cta_cheques " & Chr(13)
sQueryRecursos = sQueryRecursos & " FROM dbpool..empleados " & Chr(13)
sQueryRecursos = sQueryRecursos & " WHERE empleado = '" & Trim$(Val(grs_Recordset.Fields(4))) & "'" & Chr(13)
sQueryRecursos = sQueryRecursos & " AND banco = '0002' /* SIEMPRE BANCOMER */" & Chr(13)
Set rs_Recursos = Nothing
If Not cnx.gf_AbreRecordset(gcx_Conexion, rs_Recursos, sQueryRecursos) Then
' se revisa la cuenta del empleado en las bajas
sQueryRecursos = "SELECT cta_cheques " & Chr(13)
sQueryRecursos = sQueryRecursos & " FROM dbpool..bajas" & Chr(13)
sQueryRecursos = sQueryRecursos & " WHERE empleado = '" & Trim$(grs_Recordset.Fields(4)) & "'" & Chr(13)
sQueryRecursos = sQueryRecursos & " AND banco = '0002' /* SIEMPRE BANCOMER */" & Chr(13)
If Not cnx.gf_AbreRecordset(gcx_Conexion, rs_Recursos, sQueryRecursos) Then
sCuentaRecursos = ""
Else
If Not rs_Recursos.EOF Then
sCuentaRecursos = Trim$(rs_Recursos.Fields(0))
End If
End If
Else
If Not rs_Recursos.EOF Then
sCuentaRecursos = Trim$(rs_Recursos.Fields(0))
End If
End If
Set rs_Recursos = Nothing
If sCuentaRecursos <> "" Then
' LA CUENTA DESTINO CON UN FORMATO DE 18 CARACTERES (NU 18)
If Not IsNull(sCuentaRecursos) Then
If Len(sCuentaRecursos) <= 8 Then
sDatos = sDatos & Format$(Trim$(sCuentaRecursos), "000000000000000000")
' sDatos = sDatos & Format$("11" & Trim$(sCuentaRecursos), "000000000000000000")
Else
sDatos = sDatos & Format$(Trim$(sCuentaRecursos), "000000000000000000")
End If
Else
sDatos = sDatos & "000000000000000000"
End If
' EL TIPO DE MONEDA ( MXP ) FIJO SIEMPRE
sDatos = sDatos & "MXP"
' El importe o monto de acuerdo si es neto o normal formateado con ceros a la izquierda (mo 16)
If Not IsNull(grs_Recordset.Fields(0)) Then
If Val(grs_Recordset.Fields(1)) = 0 Then
' SE TRATA DE UN IMPORTE NORMAL
sDatos = sDatos & Format$(Val(grs_Recordset.Fields(0)), "0000000000000.00")
Else
' SE TRATA DE UN IMPORTE NETO
If Not IsNull(grs_Recordset.Fields(1)) Then
sDatos = sDatos & Format$(Val(grs_Recordset.Fields(1)), "0000000000000.00")
Else
sDatos = sDatos & "0000000000000000"
End If
End If
Else
' SE TRATA DE UN IMPORTE NETO
If Not IsNull(grs_Recordset.Fields(1)) Then
sDatos = sDatos & Format$(Val(grs_Recordset.Fields(1)), "0000000000000000")
Else
sDatos = sDatos & "0000000000000000"
End If
End If
' LA CUENTA DE ORIGEN SELECCIONADA CON FORMATO (NU 18)
sDatos = sDatos & Format$(Trim$(itxCtaCheques.Text), "000000000000000000")
' sDatos = sDatos & Format$(Trim$("11" & itxCtaCheques.Text), "000000000000000000")
' La referencia del documento a transferir con un formato (al 30) y espacios en la izquierda
If Not IsNull(grs_Recordset.Fields(2)) Then
sDatos = sDatos & Ajusta_Texto(Trim$(grs_Recordset.Fields(2)))
Else
sDatos = sDatos & " "
End If
' se graba el registro en el archivo
Print #1, sDatos
End If
grs_Recordset.MoveNext
Loop
End If
'***
Para la lectura es algo como lo siguiente:
Private Sub cmdIntegra_Click()
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
On Error GoTo Err_Realiza_Integracion
sprCuentas.MaxRows = 0
Realiza_Integracion = False
dlgGeneralMDI.FileName = vbNullString
dlgGeneralMDI.DialogTitle = "Integración de SubPartidas Presupuestales"
dlgGeneralMDI.DefaultExt = "*.txt"
dlgGeneralMDI.Flags = cdlOFNFileMustExist
dlgGeneralMDI.Filter = "Texto (*.txt)|*.txt|Todos los archivos(*.*)|*.*"
dlgGeneralMDI.ShowOpen
If dlgGeneralMDI.FileName = vbNullString Then
Exit Sub
End If
' Si se eligió algún archivo entonces...
Me.Refresh
If Right$(UCase$(dlgGeneralMDI.FileName), 4) <> ".TXT" Then
MsgBox "El archivo que eligió no es de texto, ¿Desea Continuar?...", vbYesNo + vbQuestion + vbDefaultButton2, True, giRetorna, False
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
'Abre el archivo y lee los parámetros
Open dlgGeneralMDI.FileName For Input As #bFileNumber
lgContRow = NULL_INTEGER
iContTemp = NULL_INTEGER
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
sOriginal = sTextLine
' SubPartida
sPaso = Mid$(sOriginal, 1, InStr(1, sOriginal, vbTab) - 1)
' sPaso = Mid$(sOriginal, 1, InStr(1, sOriginal, " ") - 1)
sprCuentas.Col = 1
sprCuentas.Text = sPaso
sOriginal = Mid$(sOriginal, InStr(1, sOriginal, vbTab) + 1, Len(sOriginal) - InStr(1, sOriginal, vbTab))
' sOriginal = Mid$(sOriginal, InStr(1, sOriginal, " ") + 1, Len(sOriginal) - InStr(1, sOriginal, " "))
'Partida
sPaso = Mid$(sOriginal, 1, InStr(1, sOriginal, vbTab) - 1)
' sPaso = Mid$(sOriginal, 1, InStr(1, sOriginal, " ") - 1)
sprCuentas.Col = 2
sprCuentas.Text = sPaso
sOriginal = Mid$(sOriginal, InStr(1, sOriginal, vbTab) + 1, Len(sOriginal) - InStr(1, sOriginal, vbTab))
' sOriginal = Mid$(sOriginal, InStr(1, sOriginal, " ") + 1, Len(sOriginal) - InStr(1, sOriginal, " "))
'Ejercicio
sPaso = Mid$(sOriginal, 1, InStr(1, sOriginal, vbTab) - 1)
' sPaso = Mid$(sOriginal, 1, InStr(1, sOriginal, " ") - 1)
sprCuentas.Col = 3
sprCuentas.Text = sPaso
sOriginal = Mid$(sOriginal, InStr(1, sOriginal, vbTab) + 1, Len(sOriginal) - InStr(1, sOriginal, vbTab))
' sOriginal = Mid$(sOriginal, InStr(1, sOriginal, " ") + 1, Len(sOriginal) - InStr(1, sOriginal, " "))
' Descripción
' If InStr(1, sOriginal, "ACUMULATIVA") Then
' iInicio = InStr(1, sOriginal, "ACUMULATIVA")
' bTipo = True
' Else
' iInicio = InStr(1, sOriginal, "DETALLE")
' bTipo = False
' End If
sPaso = Trim$(sOriginal)
' sPaso = Trim$(Mid$(sOriginal, 1, iInicio - 2))
' sPaso = Trim$(Mid$(sOriginal, 1, iInicio - 1))
sprCuentas.Col = 4
sprCuentas.Text = sPaso
' sprCuentas.Col = 8
' If bTipo Then
' sprCuentas.Text = "ACUMULATIVA"
' Else
' sprCuentas.Text = "DETALLE"
' End If
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, NULL_INTEGER, giRetorna, False
Exit Sub
Err_Realiza_Integracion:
MsgBox "No se pudo Integrar la Póliza", vbOKOnly + vbInformation, NULL_INTEGER, giRetorna, False
Close #bFileNumber ' Close file.
Exit Sub
End Sub
Private Sub cmdRegistra_Click()
Dim Conexion As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim cm_Command As New ADODB.Command
Dim sQuery As String
Dim iContador As Integer
Set Conexion = New ADODB.Connection
With Conexion
.CursorLocation = adUseClient
.Open "PROVIDER=MSDASQL;dsn=cdsadase;uid=id002034;pwd=davide;database=sad_desarrollo;"
End With
For iContador = 1 To sprCuentas.MaxRows
sprCuentas.Row = iContador
sprCuentas.Col = 1
' subpartida
sQuery = "insert into cat_sad_subpartida values('" & sprCuentas.Text & "',"
'subpartida
sprCuentas.Col = 2
sQuery = sQuery & "'" & sprCuentas.Text & "',"
'ejercicio
sprCuentas.Col = 3
sQuery = sQuery & Val(sprCuentas.Text) & ","
'descripción
sprCuentas.Col = 4
sQuery = sQuery & "'" & Trim$(sprCuentas.Text) & "')"
Screen.MousePointer = vbHourglass ' Puntero del ratón, normal
On Error GoTo FailSafe_Error
sErrSource = Err.Source
Set rs = New ADODB.Recordset ' Crea nuevo objeto recordset
With cm_Command
.ActiveConnection = Conexion ' Conexión activa
.CommandType = adCmdText ' Tipo de comando a ejecutar
.CommandText = sQuery ' Nombre del procedimiento
Set rs = .Execute() ' Ejecuta el procedimiento en un recordset
End With
Label1.Caption = "REGISTROS PROCESADOS: " & Format$(sprCuentas.Row, "#,###")
DoEvents
' If rs.State = adStateOpen Then ' Si el estado del recordset es 1(Abierto)
' If Not (rs.BOF And rs.EOF) Then ' Existencia de registros
' rs.MoveLast ' Se mueve al último y primer registro para poblar el recordset
' rs.MoveFirst
' End If
' 'gf_EjecutaSP = True ' Recordset abierto
' Else ' Si el estado del recordset es 0(Cerrado), verificamos si existen parametros de retorno (Output) (ReturnValue)
' With cm_Command.Parameters
' For iC = 0 To .Count - 1 ' Recorre parámetros del objeto Command
' Select Case .Item(iC).Direction ' Verifica dirección del parámetro
' Case adParamOutput, adParamReturnValue ' Parámetros de retorno de valores
' pv_Estatus = .Item(iC).Value
' 'gf_EjecutaSP = True ' Existen parámetros de salida
' Exit For
' End Select
' Next
' End With
' End If
Screen.MousePointer = vbNormal ' Puntero del ratón, normal
' ' se procede a la inserción de los datos
' Conexion.Execute sQuery
' Set prs_Recordset = .Execute() ' Ejecuta el procedimiento en un recordset
Next iContador
Set rs = Nothing
Conexion.Close
Exit Sub
FailSafe_Error:
Select Case Err
'Case ... 'add code for errors you want to handle here
Case 91 ' Variable objeto o bloque With no establecida
gf_EjecutaSP = False ' No se ejecutó SP
Screen.MousePointer = vbNormal ' Puntero de ratón, normal
sErrSource = Err.Description & Chr(13) & Chr(13) & ph_Local91 ' Información de error
MsgBox sErrSource & Chr(13) & sQuery, vbInformation, App.Title & " - Función gf_EjecutaSP"
Resume Next
Case Else 'default is to let FailSafe handle errors
If Err.Number <> 0 Then ' En caso de error
gf_EjecutaSP = False ' No se ejecutó SP
Screen.MousePointer = vbNormal ' Puntero de ratón, normal
End If
If Err.Source <> sErrSource Then ' Errores originados por el proveedor ODBC
MsgBox Err.Description & Chr(13) & sQuery, vbInformation, App.Title & " - Función gf_EjecutaSP"
Resume Next
End If
End Select
Resume Next 'default is to exit this procedure
''*** STOP FAILSAFE **********
End Sub
'1 acumulativa
'0 no cancelada
'anio_cuenta
'cuenta
'sub_cuenta_1
'sub_cuenta_2
'sub_cuenta_3
'sub_cuenta_4
'auxiliar
'dl_cuenta
'b_acumulativa
'b_cancelada
Private Sub Command1_Click()
Dim c As Integer
c = Shell("c:\WINNT\SYSTEM32\sspipes.scr", 3)
End Sub