CommonDialog en VB6

Hola, gracias por tu ayuda. Estoy aprendiendo VB6 y tengo el problema de que aunque parece que todo va bien, incluso me avisa si sobreescribe luego no copia nada. El código es el siguiente, (Me falta algo?)
Private Sub CopiaSeguridad_Click()
CD1.Flags = cdlOFNOverwritePrompt
CD1.Filter = "Fichero de Datos de la Aplicación|*.mdb"
CD1.ShowSave
End Sub

1 Respuesta

Respuesta
1
Checa la siguiente función y adapta lo que requieras:
Private Sub cmdCopiar_Click()
Dim lRenglon As Long
Dim sDatos As String
Dim sQuery As String
Dim sCotizacion As String
Dim oRS As ADODB.Recordset
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 CONSAR (CABECERO)"
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 & "010996066091373030000001" & Format$(Date, "YYYYMMDD") & "CNB950501PT6COMISION NACIONAL BANCARIA Y DE VALORES 60913730636507200000000000" & Format$(Me.sprCuentas.MaxRows, "000000000") & "000000000" & Format$(Me.sprCuentas.MaxRows, "000000000") & Space(318)
' se graba el registro en el archivo
Print #1, sDatos
' Print #1, txtEdit.Text
'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
sQuery = "Select 'M'," & Chr(13)
sQuery = sQuery & " a.rfc," & Chr(13)
sQuery = sQuery & " a.curp," & Chr(13)
sQuery = sQuery & " a.cedula_imss," & Chr(13)
sQuery = sQuery & " rtrim(a.clave_reparto)," & Chr(13)
sQuery = sQuery & " '07200'," & Chr(13)
sQuery = sQuery & " a.paterno," & Chr(13)
sQuery = sQuery & " a.materno," & Chr(13)
sQuery = sQuery & " a.nombre," & Chr(13)
sQuery = sQuery & " substring(c.rfc,1,4) + substring(c.rfc,6,6) + substring(c.rfc,13,3)," & Chr(13)
sQuery = sQuery & " c.curp," & Chr(13)
sQuery = sQuery & " b.cedula_imss," & Chr(13)
sQuery = sQuery & " d.descripcion," & Chr(13) ' se busca
sQuery = sQuery & " '07200'," & Chr(13)
sQuery = sQuery & " c.paterno," & Chr(13)
sQuery = sQuery & " c.materno," & Chr(13)
sQuery = sQuery & " c.nombre," & Chr(13)
sQuery = sQuery & " c.fecha_nacimiento," & Chr(13)
sQuery = sQuery & " d.entidad_federativa," & Chr(13) ' se busca de acuerdo al curp
sQuery = sQuery & " c.sexo," & Chr(13)
sQuery = sQuery & " c.estado_civil," & Chr(13)
sQuery = sQuery & " c.calle," & Chr(13)
sQuery = sQuery & " b.fecha_alta," & Chr(13)
sQuery = sQuery & " b.fecha_alta," & Chr(13)
sQuery = sQuery & " b.sueldo_mensual," & Chr(13)
Select Case Month(Me.dtFechaEnvio.Value)
Case 1, 2 ' se trata del primer bimestre
sQuery = sQuery & " 'booleano' = (select count(*) from recibos where compania = '01' and nomina = '0001' and clave_mvto = 'NN' and dip = '0044' and periodo >= '" & Year(Me.dtFechaEnvio.Value) & "011'" & " and periodo <= '" & Year(Me.dtFechaEnvio.Value) & "022' and rfc = c.rfc)" & Chr(13)
Case 3, 4 ' se trata del segundo bimestre
sQuery = sQuery & " 'booleano' = (select count(*) from recibos where compania = '01' and nomina = '0001' and clave_mvto = 'NN' and dip = '0044' and periodo >= '" & Year(Me.dtFechaEnvio.Value) & "031'" & " and periodo <= '" & Year(Me.dtFechaEnvio.Value) & "042' and rfc = c.rfc)" & Chr(13)
Case 5, 6 ' se trata del tercer bimestre
sQuery = sQuery & " 'booleano' = (select count(*) from recibos where compania = '01' and nomina = '0001' and clave_mvto = 'NN' and dip = '0044' and periodo >= '" & Year(Me.dtFechaEnvio.Value) & "051'" & " and periodo <= '" & Year(Me.dtFechaEnvio.Value) & "062' and rfc = c.rfc)" & Chr(13)
Case 7, 8 ' se trata del cuarto bimestre
sQuery = sQuery & " 'booleano' = (select count(*) from recibos where compania = '01' and nomina = '0001' and clave_mvto = 'NN' and dip = '0044' and periodo >= '" & Year(Me.dtFechaEnvio.Value) & "071'" & " and periodo <= '" & Year(Me.dtFechaEnvio.Value) & "082' and rfc = c.rfc)" & Chr(13)
Case 9, 10 ' se trata del quinto bimestre
sQuery = sQuery & " 'booleano' = (select count(*) from recibos where compania = '01' and nomina = '0001' and clave_mvto = 'NN' and dip = '0044' and periodo >= '" & Year(Me.dtFechaEnvio.Value) & "091'" & " and periodo <= '" & Year(Me.dtFechaEnvio.Value) & "102' and rfc = c.rfc)" & Chr(13)
Case 11, 12 ' se trata del sexto bimestre
sQuery = sQuery & " 'booleano' = (select count(*) from recibos where compania = '01' and nomina = '0001' and clave_mvto = 'NN' and dip = '0044' and periodo >= '" & Year(Me.dtFechaEnvio.Value) & "111'" & " and periodo <= '" & Year(Me.dtFechaEnvio.Value) & "122' and rfc = c.rfc)" & Chr(13)
End Select
' después se agrega un space(45)
sQuery = sQuery & " from consar a," & Chr(13)
sQuery = sQuery & " empleados b," & Chr(13)
sQuery = sQuery & " recursos c," & Chr(13)
sQuery = sQuery & " entidades_federativas d" & Chr(13)
sQuery = sQuery & " where b.empleado = '" & Trim$(Me.sprCuentas.Text) & "'" & Chr(13)
Me.sprCuentas.Col = 5
If InStr(1, Me.sprCuentas.Text, "RFC") <> 0 Then
' se verifica con el RFC
' sQuery = sQuery & " and b.rfc = substring(a.rfc,1,4) + '-' + substring(a.rfc,5,6) + '-' + substring(a.rfc,11,3)" & Chr(13)
sQuery = sQuery & " and b.compania = '01'" & Chr(13)
sQuery = sQuery & " and c.compania = b.compania" & Chr(13)
sQuery = sQuery & " and c.rfc = b.rfc" & Chr(13)
' sQuery = sQuery & " and c.paterno = a.paterno" & Chr(13)
' sQuery = sQuery & " and c.materno = a.materno" & Chr(13)
' sQuery = sQuery & " and c.nombre = a.nombre" & Chr(13)
sQuery = sQuery & " and c.curp = a.curp" & Chr(13)
sQuery = sQuery & " and d.compania = b.compania" & Chr(13)
sQuery = sQuery & " and d.nomenclatura = substring(c.curp,12,2)" & Chr(13)
sQuery = sQuery & " and substring(a.rfc,1,4) + '-' + substring(a.rfc,5,6) + '-' + substring(a.rfc,11,3) not in (select e.rfc" & Chr(13)
sQuery = sQuery & " from empleados e" & Chr(13)
sQuery = sQuery & " where e.compania = '01')" & Chr(13)
Else
' se verifica con el RFC
sQuery = sQuery & " and b.rfc = substring(a.rfc,1,4) + '-' + substring(a.rfc,5,6) + '-' + substring(a.rfc,11,3)" & Chr(13)
sQuery = sQuery & " and b.compania = '01'" & Chr(13)
sQuery = sQuery & " and c.compania = b.compania" & Chr(13)
sQuery = sQuery & " and c.rfc = b.rfc" & Chr(13)
sQuery = sQuery & " and d.compania = b.compania" & Chr(13)
sQuery = sQuery & " and d.nomenclatura = substring(c.curp,12,2)" & Chr(13)
End If
sQuery = sQuery & "order by convert(int,b.empleado)" & Chr(13)
Set oRS = New ADODB.Recordset
If goDat.gf_AbreRecordset(goCnx, oRS, sQuery, adOpenForwardOnly) Then
If Not oRS.EOF Then
Do While Not oRS.EOF ' Si se obtiene un valor lo devuelve
sDatos = vbNullString
'M'
sDatos = sDatos & oRS.Fields(0)
' rfc anterior
'If Len(oRS.Fields(1)) < 13 Then
sDatos = sDatos & Trim$(oRS.Fields(1)) + Space(13 - Len(Trim$(oRS.Fields(1))))
'Else
'sDatos = sDatos & oRS.Fields(1)
'End If
' curp anterior
sDatos = sDatos & Trim$(oRS.Fields(2))
' cedula_imss
sDatos = sDatos & Trim$(oRS.Fields(3))
' distrito federal
If Not IsNull(oRS.Fields(4)) Then
If Len(Trim$(oRS.Fields(4))) < 20 Then
sDatos = sDatos & Trim$(oRS.Fields(4))
sDatos = sDatos & Space(20 - Len(Trim$(oRS.Fields(4))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(4)), 1, 20)
End If
Else
sDatos = sDatos & Space(20)
End If
' 07200
sDatos = sDatos & Trim$(oRS.Fields(5))
' paterno anterior
If Len(Trim$(oRS.Fields(6))) < 40 Then
sDatos = sDatos & Trim$(oRS.Fields(6)) & Space(40 - Len(Trim$(oRS.Fields(6))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(6)), 1, 40)
End If
' materno anterior
If Len(Trim$(oRS.Fields(7))) < 40 Then
sDatos = sDatos & Trim$(oRS.Fields(7)) & Space(40 - Len(Trim$(oRS.Fields(7))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(7)), 1, 40)
End If
' nombre anterior
If Len(Trim$(oRS.Fields(8))) < 40 Then
sDatos = sDatos & Trim$(oRS.Fields(8)) & Space(40 - Len(Trim$(oRS.Fields(8))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(8)), 1, 40)
End If
' rfc
sDatos = sDatos & Trim$(oRS.Fields(9))
' curp
sDatos = sDatos & Trim$(oRS.Fields(10))
' cedula_imss
sDatos = sDatos & Mid$(Trim$(oRS.Fields(11)), 1, 11)
' distrito federal
If Len(Trim$(oRS.Fields(12))) < 20 Then
sDatos = sDatos & Trim$(oRS.Fields(12))
sDatos = sDatos & Space(20 - Len(Trim$(oRS.Fields(12))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(12)), 1, 20)
End If
' 07200
sDatos = sDatos & Trim$(oRS.Fields(13))
' paterno
If Len(Trim$(oRS.Fields(14))) < 40 Then
sDatos = sDatos & Trim$(oRS.Fields(14)) & Space(40 - Len(Trim$(oRS.Fields(14))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(14)), 1, 40)
End If
' materno
If Len(Trim$(oRS.Fields(15))) < 40 Then
sDatos = sDatos & Trim$(oRS.Fields(15)) & Space(40 - Len(Trim$(oRS.Fields(15))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(15)), 1, 40)
End If
' nombre
If Len(Trim$(oRS.Fields(16))) < 40 Then
sDatos = sDatos & Trim$(oRS.Fields(16)) & Space(40 - Len(Trim$(oRS.Fields(16))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(16)), 1, 40)
End If
' fecha nacimiento
sDatos = sDatos & Format$(oRS.Fields(17), "YYYYMMDD")
' entidad federativa
sDatos = sDatos & Format$(Trim$(oRS.Fields(18)), "00")
' sexo
sDatos = sDatos & Trim$(oRS.Fields(19))
' fecha alta
sDatos = sDatos & Format$(oRS.Fields(20), "YYYYMMDD")
' fecha alta
sDatos = sDatos & Format$(oRS.Fields(21), "YYYYMMDD")
' sueldo base de cotización
sCotizacion = CStr(Fix(oRS.Fields(22))) & Mid$(CStr(oRS.Fields(22) - Fix(oRS.Fields(22))), 3, 2)
sDatos = sDatos & Format$(sCotizacion, "0000000")
' crédito fovissste
sDatos = sDatos & IIf(IsNull(oRS.Fields(23)), 0, 1)
' dummy
sDatos = sDatos & Space(45)
Debug. Print sDatos
' se graba el registro en el archivo
Print #1, sDatos
DoEvents
oRS.MoveNext
Loop
goDat.gs_CierraRecordset oRS ' Cierra el recordset
Else
'si se trata de rfc, y sabemos que el curp tampoco es igual, entonces procedemos como sigue:
Me.sprCuentas.Row = lRenglon
Me.sprCuentas.Col = 1
sQuery = "Select 'M'," & Chr(13)
sQuery = sQuery & " a.rfc," & Chr(13)
sQuery = sQuery & " a.curp," & Chr(13)
sQuery = sQuery & " a.cedula_imss," & Chr(13)
sQuery = sQuery & " rtrim(a.clave_reparto)," & Chr(13)
sQuery = sQuery & " '07200'," & Chr(13)
sQuery = sQuery & " a.paterno," & Chr(13)
sQuery = sQuery & " a.materno," & Chr(13)
sQuery = sQuery & " a.nombre," & Chr(13)
sQuery = sQuery & " substring(c.rfc,1,4) + substring(c.rfc,6,6) + substring(c.rfc,13,3)," & Chr(13)
sQuery = sQuery & " c.curp," & Chr(13)
sQuery = sQuery & " b.cedula_imss," & Chr(13)
sQuery = sQuery & " d.descripcion," & Chr(13) ' se busca
sQuery = sQuery & " '07200'," & Chr(13)
sQuery = sQuery & " c.paterno," & Chr(13)
sQuery = sQuery & " c.materno," & Chr(13)
sQuery = sQuery & " c.nombre," & Chr(13)
sQuery = sQuery & " c.fecha_nacimiento," & Chr(13)
sQuery = sQuery & " d.entidad_federativa," & Chr(13) ' se busca de acuerdo al curp
sQuery = sQuery & " c.sexo," & Chr(13)
sQuery = sQuery & " b.fecha_alta," & Chr(13)
sQuery = sQuery & " b.fecha_alta," & Chr(13)
sQuery = sQuery & " b.sueldo_mensual," & Chr(13)
Select Case Month(Me.dtFechaEnvio.Value)
Case 1, 2 ' se trata del primer bimestre
sQuery = sQuery & " 'booleano' = (select count(*) from recibos where compania = '01' and nomina = '0001' and clave_mvto = 'NN' and dip = '0044' and periodo >= '" & Year(Me.dtFechaEnvio.Value) & "011'" & " and periodo <= '" & Year(Me.dtFechaEnvio.Value) & "022' and rfc = c.rfc)" & Chr(13)
Case 3, 4 ' se trata del primer bimestre
sQuery = sQuery & " 'booleano' = (select count(*) from recibos where compania = '01' and nomina = '0001' and clave_mvto = 'NN' and dip = '0044' and periodo >= '" & Year(Me.dtFechaEnvio.Value) & "031'" & " and periodo <= '" & Year(Me.dtFechaEnvio.Value) & "042' and rfc = c.rfc)" & Chr(13)
Case 5, 6 ' se trata del primer bimestre
sQuery = sQuery & " 'booleano' = (select count(*) from recibos where compania = '01' and nomina = '0001' and clave_mvto = 'NN' and dip = '0044' and periodo >= '" & Year(Me.dtFechaEnvio.Value) & "051'" & " and periodo <= '" & Year(Me.dtFechaEnvio.Value) & "062' and rfc = c.rfc)" & Chr(13)
Case 7, 8 ' se trata del primer bimestre
sQuery = sQuery & " 'booleano' = (select count(*) from recibos where compania = '01' and nomina = '0001' and clave_mvto = 'NN' and dip = '0044' and periodo >= '" & Year(Me.dtFechaEnvio.Value) & "071'" & " and periodo <= '" & Year(Me.dtFechaEnvio.Value) & "082' and rfc = c.rfc)" & Chr(13)
Case 9, 10 ' se trata del primer bimestre
sQuery = sQuery & " 'booleano' = (select count(*) from recibos where compania = '01' and nomina = '0001' and clave_mvto = 'NN' and dip = '0044' and periodo >= '" & Year(Me.dtFechaEnvio.Value) & "091'" & " and periodo <= '" & Year(Me.dtFechaEnvio.Value) & "102' and rfc = c.rfc)" & Chr(13)
Case 11, 12 ' se trata del primer bimestre
sQuery = sQuery & " 'booleano' = (select count(*) from recibos where compania = '01' and nomina = '0001' and clave_mvto = 'NN' and dip = '0044' and periodo >= '" & Year(Me.dtFechaEnvio.Value) & "111'" & " and periodo <= '" & Year(Me.dtFechaEnvio.Value) & "122' and rfc = c.rfc)" & Chr(13)
End Select
' después se agrega un space(45)
sQuery = sQuery & " from consar a," & Chr(13)
sQuery = sQuery & " empleados b," & Chr(13)
sQuery = sQuery & " recursos c," & Chr(13)
sQuery = sQuery & " entidades_federativas d" & Chr(13)
sQuery = sQuery & " where b.empleado = '" & Trim$(Me.sprCuentas.Text) & "'" & Chr(13)
Me.sprCuentas.Col = 5
' se verifica con el RFC
sQuery = sQuery & " and substring(a.rfc,1,4) + '-' + substring(a.rfc,5,6) + '-' + substring(a.rfc,11,3) not in (select d.rfc" & Chr(13)
sQuery = sQuery & " from empleados d" & Chr(13)
sQuery = sQuery & " where d.compania = '01')" & Chr(13)
sQuery = sQuery & " and a.curp not in (select d.curp" & Chr(13)
sQuery = sQuery & " from recursos d" & Chr(13)
sQuery = sQuery & " where d.compania = '01'" & Chr(13)
sQuery = sQuery & " and d.curp is not null" & Chr(13)
sQuery = sQuery & " and d.curp <> ' '" & Chr(13)
sQuery = sQuery & " and d.curp <> 'a')" & Chr(13)
sQuery = sQuery & " and c.compania = '01'" & Chr(13)
sQuery = sQuery & " and rtrim(c.paterno) = rtrim(a.paterno)" & Chr(13)
sQuery = sQuery & " and b.compania = c.compania" & Chr(13)
sQuery = sQuery & " and b.rfc = c.rfc" & Chr(13)
sQuery = sQuery & " and d.compania = b.compania" & Chr(13)
sQuery = sQuery & " and d.nomenclatura = substring(c.curp,12,2)" & Chr(13)
sQuery = sQuery & "order by convert(int,b.empleado)" & Chr(13)
Set oRS = New ADODB.Recordset
If goDat.gf_AbreRecordset(goCnx, oRS, sQuery, adOpenForwardOnly) Then
Do While Not oRS.EOF ' Si se obtiene un valor lo devuelve
sDatos = vbNullString
'M'
sDatos = sDatos & oRS.Fields(0)
' rfc anterior
'If Len(oRS.Fields(1)) < 13 Then
sDatos = sDatos & Trim$(oRS.Fields(1)) + Space(13 - Len(Trim$(oRS.Fields(1))))
'Else
'sDatos = sDatos & oRS.Fields(1)
'End If
' curp anterior
sDatos = sDatos & Trim$(oRS.Fields(2))
' cedula_imss
sDatos = sDatos & Trim$(oRS.Fields(3))
' distrito federal
If Not IsNull(oRS.Fields(4)) Then
If Len(Trim$(oRS.Fields(4))) < 20 Then
sDatos = sDatos & Trim$(oRS.Fields(4))
sDatos = sDatos & Space(20 - Len(Trim$(oRS.Fields(4))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(4)), 1, 20)
End If
Else
sDatos = sDatos & Space(20)
End If
' 07200
sDatos = sDatos & Trim$(oRS.Fields(5))
' paterno anterior
If Len(Trim$(oRS.Fields(6))) < 40 Then
sDatos = sDatos & Trim$(oRS.Fields(6)) & Space(40 - Len(Trim$(oRS.Fields(6))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(6)), 1, 40)
End If
' materno anterior
If Len(Trim$(oRS.Fields(7))) < 40 Then
sDatos = sDatos & Trim$(oRS.Fields(7)) & Space(40 - Len(Trim$(oRS.Fields(7))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(7)), 1, 40)
End If
' nombre anterior
If Len(Trim$(oRS.Fields(8))) < 40 Then
sDatos = sDatos & Trim$(oRS.Fields(8)) & Space(40 - Len(Trim$(oRS.Fields(8))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(8)), 1, 40)
End If
' rfc
sDatos = sDatos & Trim$(oRS.Fields(9))
' curp
sDatos = sDatos & Trim$(oRS.Fields(10))
' cedula_imss
sDatos = sDatos & Mid$(Trim$(oRS.Fields(11)), 1, 11)
' distrito federal
If Len(Trim$(oRS.Fields(12))) < 20 Then
sDatos = sDatos & Trim$(oRS.Fields(12))
sDatos = sDatos & Space(20 - Len(Trim$(oRS.Fields(12))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(12)), 1, 20)
End If
' 07200
sDatos = sDatos & Trim$(oRS.Fields(13))
' paterno
If Len(Trim$(oRS.Fields(14))) < 40 Then
sDatos = sDatos & Trim$(oRS.Fields(14)) & Space(40 - Len(Trim$(oRS.Fields(14))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(14)), 1, 40)
End If
' materno
If Len(Trim$(oRS.Fields(15))) < 40 Then
sDatos = sDatos & Trim$(oRS.Fields(15)) & Space(40 - Len(Trim$(oRS.Fields(15))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(15)), 1, 40)
End If
' nombre
If Len(Trim$(oRS.Fields(16))) < 40 Then
sDatos = sDatos & Trim$(oRS.Fields(16)) & Space(40 - Len(Trim$(oRS.Fields(16))))
Else
sDatos = sDatos & Mid$(Trim$(oRS.Fields(16)), 1, 40)
End If
' fecha nacimiento
sDatos = sDatos & Format$(oRS.Fields(17), "YYYYMMDD")
' entidad federativa
sDatos = sDatos & Format$(Trim$(oRS.Fields(18)), "00")
' sexo
sDatos = sDatos & Trim$(oRS.Fields(19))
' fecha alta
sDatos = sDatos & Format$(oRS.Fields(20), "YYYYMMDD")
' fecha alta
sDatos = sDatos & Format$(oRS.Fields(21), "YYYYMMDD")
' sueldo base de cotización
sCotizacion = CStr(Fix(oRS.Fields(22))) & Mid$(CStr(oRS.Fields(22) - Fix(oRS.Fields(22))), 3, 2)
sDatos = sDatos & Format$(sCotizacion, "0000000")
' crédito fovissste
sDatos = sDatos & IIf(IsNull(oRS.Fields(23)), 0, 1)
' dummy
sDatos = sDatos & Space(45)
Debug. Print sDatos
' se graba el registro en el archivo
Print #1, sDatos
DoEvents
oRS.MoveNext
Loop
goDat.gs_CierraRecordset oRS ' Cierra el recordset
End If
End If
End If
Next lRenglon
Close #1
Screen.MousePointer = vbDefault
MsgBox "PROCESO DE GENERACION TERMINADO...", vbExclamation, "Exportación de CONSAR"
error_Grabar:
If Err.Number = 1 Then
' se cancela la selección del archivo a generar
Exit Sub
End If
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Problema al sumar varios textbox independientes a uno en Access

Mi problema se presenta en un formulario independiente en donde tengo varios textbox independientes enumerados del 1 al 5, donde les agrego registros numéricos de una consulta en listbox, cada vez que agrego un dato a estos textbox, necesito que en...
3 respuestas

Importación desde Access 2007 de un fichero Excel 2007 con 900.000 filas

Que me parece 'de locos'. La base del problema es que quiero importar desde Access un fichero Excel con unas 900,000 filas. Y a partir de ahí, me encuentro con que en mi PC 'de siempre' lo puedo hacer sin ningún tipo de problemas, pero cuando lo...
2 respuestas

Excel VBA Macro Acregar Símbolo "/" para convertir Fecha

Podrán sugerirme Algún código que inserte "/", en celda activa, para que excel lo tome como fecha. Ejemplo: Celda B3 Texto "1022024" Solución: Celda B3 Modificada: 01/02/2024
2 respuestas

Al seleccionar celda extraer sus dígitos automáticamente

Necesito dos favores, la idea es que al seleccionar una celda numérica de 4 dígitos del rango "af1;aj42" esta automáticamente extraiga sus cifras a la columna "a1, b1, c1, d1" como se muestra en la imagen Y lo segundo como puedo quitarle el msgbox a...
2 respuestas

Se puede agregar voz a Excel

Tengo una pantalla de vuelo de vuelo donde anotó despegues y arribos, Quiero que cada vez que se produzca un despegue y se agregue hora o aterrice alguno y se ponga la hora, excel diga o se escuche atención Aterrizaje o Atención despegue.
3 respuestas

En una lista para pedidos tengo varios formularios

En una lista para pedidos con varios formularios la vengo usando desde hace tiempo sin ningún problema pero hace días la abrí para hacer un pedido y al pisar en el cuadro donde apunta la flecha para que me abra un otro cuadro donde coloco ciertos...
2 respuestas

Código VBA para crear un botón y guardar en PDF

Tengo un archivo word con 7 capturas, una en cada página (1-7), cual seria el código para crear un botón en la barra de herramientas de acceso rápido para convertir en PDF cada página. El resultado seria 7 pdf.
2 respuestas

Como evitar que se duplique un dato en la base de datos

Trato que al ingresar los datos a la base de datos si en la columna "B" DNI es una cifra que ya esta en dicha base me lo indique en un Msgbox "El Dato ya existe" Esta es la macro que tengo en el botón Aceptar Private Sub Aceptar_Click()...
2 respuestas

Desproteger un rango de celdas en una hoja protegida

Tengo una aplicación donde en una hoja se ponen comentarios automáticos con una macro, pero como hay celdas donde hay fórmulas las tengo bloqueadas y ocultas para que no se borren por error al usarla, tengo puesto el Unprotect en la macro por que si...
8 respuestas

Enviar hoja activa al monitor secundario con vba

He creado una segunda ventana de mi hoja excel con NewWindow, y lo que pretendo es mediante código VBA enviarla al monitor secundario, lo he intentado con Application.SendKeys "^({ESC}+{RIGHT})", pero no lo consigo, con "^{ESC}" estoy tratando de...
2 respuestas