Visual Basic 6.0
Ayudame necesito exportar los datos que están dentro de un archivo plano delimitado por tabulaciones a una tabla de access por medio de interfaces de Visual Basic 6.0 ayudame con el código fuente o algún ejemplo claro
1 Respuesta
Respuesta de denciso
1
Haber, adapta lo siguiente a lo que desees:
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
On Error GoTo Err_Realiza_Integracion
sprCuentas.MaxRows = 0
'Realiza_Integracion = False
cmgDial.FileName = vbNullString
cmgDial.DialogTitle = "Integración de Datos de CONSAR"
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
sOriginal = sTextLine
' RFC
sPaso = Mid$(sOriginal, 2, 13)
sprCuentas.Col = 1
sprCuentas.Text = sPaso
'curp
sPaso = Mid$(sOriginal, 15, 18)
sprCuentas.Col = 2
sprCuentas.Text = sPaso
' cedula imss
sPaso = Mid$(sOriginal, 33, 11)
sprCuentas.Col = 3
sprCuentas.Text = sPaso
' paterno
sPaso = Mid$(sOriginal, 44, 40)
sprCuentas.Col = 4
sprCuentas.Text = sPaso
' materno
sPaso = Mid$(sOriginal, 84, 40)
sprCuentas.Col = 5
sprCuentas.Text = sPaso
' nombre
sPaso = Mid$(sOriginal, 124, 40)
sprCuentas.Col = 6
sprCuentas.Text = sPaso
' clave pagaduria
sPaso = Mid$(sOriginal, 164, 5)
sprCuentas.Col = 7
sprCuentas.Text = sPaso
' clave reparto
sPaso = Mid$(sOriginal, 169, 20)
sprCuentas.Col = 8
sprCuentas.Text = sPaso
' fecha nacimiento
sPaso = Mid$(sOriginal, 189, 8)
sPaso = Mid$(sPaso, 7, 2) & "/" & Mid$(sPaso, 5, 2) & "/" & Mid$(sPaso, 1, 4)
sprCuentas.Col = 9
sprCuentas.Text = sPaso
' entidad federativa nacimiento
sPaso = Mid$(sOriginal, 197, 2)
sprCuentas.Col = 10
sprCuentas.Text = sPaso
' sexo
sPaso = Mid$(sOriginal, 199, 1)
sprCuentas.Col = 11
sprCuentas.Text = sPaso
' estado civil
sPaso = Mid$(sOriginal, 200, 1)
sprCuentas.Col = 12
sprCuentas.Text = sPaso
' domicilio
sPaso = Mid$(sOriginal, 201, 60)
sprCuentas.Col = 13
sprCuentas.Text = sPaso
' localidad
sPaso = Mid$(sOriginal, 261, 30)
sprCuentas.Col = 14
sprCuentas.Text = sPaso
' población
sPaso = Mid$(sOriginal, 291, 30)
sprCuentas.Col = 15
sprCuentas.Text = sPaso
' código postal
sPaso = Mid$(sOriginal, 321, 5)
sprCuentas.Col = 16
sprCuentas.Text = sPaso
' entidad federativa
sPaso = Mid$(sOriginal, 326, 2)
sprCuentas.Col = 17
sprCuentas.Text = sPaso
' nombramiento
sPaso = Mid$(sOriginal, 328, 1)
sprCuentas.Col = 18
sprCuentas.Text = sPaso
' ICEFA
sPaso = Mid$(sOriginal, 329, 3)
sprCuentas.Col = 19
sprCuentas.Text = sPaso
' número de control interno
sPaso = Mid$(sOriginal, 332, 30)
sprCuentas.Col = 20
sprCuentas.Text = sPaso
' número de empleado
sPaso = Mid$(sOriginal, 362, 10)
sprCuentas.Col = 21
sprCuentas.Text = sPaso
' fecha alta
sPaso = Mid$(sOriginal, 372, 8)
sPaso = Mid$(sPaso, 7, 2) & "/" & Mid$(sPaso, 5, 2) & "/" & Mid$(sPaso, 1, 4)
sprCuentas.Col = 22
sprCuentas.Text = sPaso
' fecha alta
sPaso = Mid$(sOriginal, 380, 8)
sPaso = Mid$(sPaso, 7, 2) & "/" & Mid$(sPaso, 5, 2) & "/" & Mid$(sPaso, 1, 4)
sprCuentas.Col = 23
sprCuentas.Text = sPaso
' sueldo basico cotizacion
sPaso = Mid$(sOriginal, 388, 5) & "." & Mid$(sOriginal, 393, 2)
sprCuentas.Col = 24
sprCuentas.Text = Val(sPaso)
' sueldo basico cotizacion vivienda
sPaso = Mid$(sOriginal, 395, 5) & "." & Mid$(sOriginal, 400, 2)
sprCuentas.Col = 25
sprCuentas.Text = Val(sPaso)
' salario integrado
sPaso = Mid$(sOriginal, 402, 5) & "." & Mid$(sOriginal, 406, 2)
sprCuentas.Col = 26
sprCuentas.Text = Val(sPaso)
' días laborados
sPaso = Mid$(sOriginal, 409, 3)
sprCuentas.Col = 27
sprCuentas.Text = Val(sPaso)
' credito fovissste
sPaso = Mid$(sOriginal, 412, 1)
sprCuentas.Col = 28
sprCuentas.Text = sPaso
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 CONSAR", 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 cmdaceptar_Click()
' primero borramos los datos de la tabla para ser actualizado con los que se leyeron
Dim sQuery As String
Dim dContador As Double
Dim iContador As Integer
sQuery = "DELETE consar"
goCnx.BeginTrans
If Not Err Then
goCnx.Execute sQuery
If Not Err Then
goCnx.CommitTrans
Else
goCnx.RollbackTrans
MsgBox "Error al borrar datos", vbCritical, "Error de Datos"
End If
Else
MsgBox "Error al procesar los datos, no se pudo concluir la operación...", vbCritical, "Error de Datos"
Exit Sub
End If
goCnx.BeginTrans
If Not Err Then
' procesamos todos los datos del spread para insertarlos en la tabla "CONSAR"
For dContador = 1 To Me.sprCuentas.MaxRows
Me.sprCuentas.Row = dContador
Me.Label1.Caption = "Registros Procesados: " & Format$(dContador, "###,##0") & "/" & Format$(Me.sprCuentas.MaxRows, "###,##0")
DoEvents
sQuery = "insert into consar(rfc,curp,cedula_imss,paterno,materno,nombre,clave_pagaduria,clave_reparto,fecha_nacimiento,entidad_nacimiento,sexo,estado_civil,domicilio,localidad,poblacion,codigo_postal,entidad_federativa,nombramiento,icefa,control_interno,empleado,fecha_alta,fecha_ingreso,sueldo_basico_cotizacion,sueldo_basico_vivienda,salario_integrado,dias_laborados,credito_fovissste)"
sQuery = sQuery & " values("
For iContador = 1 To 28
Me.sprCuentas.Col = iContador
Select Case iContador
Case 7, 12, 16, 18, 19, 24, 25, 26, 27
sQuery = sQuery & Me.sprCuentas.Value & ","
Case 9, 22, 23
sQuery = sQuery & "'" & Format$(Me.sprCuentas.Text, "YYYYMMDD") & "',"
Case Else
sQuery = sQuery & "'" & Me.sprCuentas.Text & "',"
End Select
Next iContador
sQuery = Left$(sQuery, Len(sQuery) - 1) & ")"
' ahora procesamos el insert en la base datos
goCnx.Execute sQuery
If Err Then
goCnx.RollbackTrans
End If
Next dContador
goCnx.CommitTrans
Else
MsgBox "Error al procesar los datos, no se pudo concluir la operación...", vbCritical, "Error de Datos"
Exit Sub
End If
MsgBox "Los datos de CONSAR se insertaron con éxito en la base de datos...", vbInformation, "Inserción de Datos"
Me.Label1.Caption = ""
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
On Error GoTo Err_Realiza_Integracion
sprCuentas.MaxRows = 0
'Realiza_Integracion = False
cmgDial.FileName = vbNullString
cmgDial.DialogTitle = "Integración de Datos de CONSAR"
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
sOriginal = sTextLine
' RFC
sPaso = Mid$(sOriginal, 2, 13)
sprCuentas.Col = 1
sprCuentas.Text = sPaso
'curp
sPaso = Mid$(sOriginal, 15, 18)
sprCuentas.Col = 2
sprCuentas.Text = sPaso
' cedula imss
sPaso = Mid$(sOriginal, 33, 11)
sprCuentas.Col = 3
sprCuentas.Text = sPaso
' paterno
sPaso = Mid$(sOriginal, 44, 40)
sprCuentas.Col = 4
sprCuentas.Text = sPaso
' materno
sPaso = Mid$(sOriginal, 84, 40)
sprCuentas.Col = 5
sprCuentas.Text = sPaso
' nombre
sPaso = Mid$(sOriginal, 124, 40)
sprCuentas.Col = 6
sprCuentas.Text = sPaso
' clave pagaduria
sPaso = Mid$(sOriginal, 164, 5)
sprCuentas.Col = 7
sprCuentas.Text = sPaso
' clave reparto
sPaso = Mid$(sOriginal, 169, 20)
sprCuentas.Col = 8
sprCuentas.Text = sPaso
' fecha nacimiento
sPaso = Mid$(sOriginal, 189, 8)
sPaso = Mid$(sPaso, 7, 2) & "/" & Mid$(sPaso, 5, 2) & "/" & Mid$(sPaso, 1, 4)
sprCuentas.Col = 9
sprCuentas.Text = sPaso
' entidad federativa nacimiento
sPaso = Mid$(sOriginal, 197, 2)
sprCuentas.Col = 10
sprCuentas.Text = sPaso
' sexo
sPaso = Mid$(sOriginal, 199, 1)
sprCuentas.Col = 11
sprCuentas.Text = sPaso
' estado civil
sPaso = Mid$(sOriginal, 200, 1)
sprCuentas.Col = 12
sprCuentas.Text = sPaso
' domicilio
sPaso = Mid$(sOriginal, 201, 60)
sprCuentas.Col = 13
sprCuentas.Text = sPaso
' localidad
sPaso = Mid$(sOriginal, 261, 30)
sprCuentas.Col = 14
sprCuentas.Text = sPaso
' población
sPaso = Mid$(sOriginal, 291, 30)
sprCuentas.Col = 15
sprCuentas.Text = sPaso
' código postal
sPaso = Mid$(sOriginal, 321, 5)
sprCuentas.Col = 16
sprCuentas.Text = sPaso
' entidad federativa
sPaso = Mid$(sOriginal, 326, 2)
sprCuentas.Col = 17
sprCuentas.Text = sPaso
' nombramiento
sPaso = Mid$(sOriginal, 328, 1)
sprCuentas.Col = 18
sprCuentas.Text = sPaso
' ICEFA
sPaso = Mid$(sOriginal, 329, 3)
sprCuentas.Col = 19
sprCuentas.Text = sPaso
' número de control interno
sPaso = Mid$(sOriginal, 332, 30)
sprCuentas.Col = 20
sprCuentas.Text = sPaso
' número de empleado
sPaso = Mid$(sOriginal, 362, 10)
sprCuentas.Col = 21
sprCuentas.Text = sPaso
' fecha alta
sPaso = Mid$(sOriginal, 372, 8)
sPaso = Mid$(sPaso, 7, 2) & "/" & Mid$(sPaso, 5, 2) & "/" & Mid$(sPaso, 1, 4)
sprCuentas.Col = 22
sprCuentas.Text = sPaso
' fecha alta
sPaso = Mid$(sOriginal, 380, 8)
sPaso = Mid$(sPaso, 7, 2) & "/" & Mid$(sPaso, 5, 2) & "/" & Mid$(sPaso, 1, 4)
sprCuentas.Col = 23
sprCuentas.Text = sPaso
' sueldo basico cotizacion
sPaso = Mid$(sOriginal, 388, 5) & "." & Mid$(sOriginal, 393, 2)
sprCuentas.Col = 24
sprCuentas.Text = Val(sPaso)
' sueldo basico cotizacion vivienda
sPaso = Mid$(sOriginal, 395, 5) & "." & Mid$(sOriginal, 400, 2)
sprCuentas.Col = 25
sprCuentas.Text = Val(sPaso)
' salario integrado
sPaso = Mid$(sOriginal, 402, 5) & "." & Mid$(sOriginal, 406, 2)
sprCuentas.Col = 26
sprCuentas.Text = Val(sPaso)
' días laborados
sPaso = Mid$(sOriginal, 409, 3)
sprCuentas.Col = 27
sprCuentas.Text = Val(sPaso)
' credito fovissste
sPaso = Mid$(sOriginal, 412, 1)
sprCuentas.Col = 28
sprCuentas.Text = sPaso
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 CONSAR", 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 cmdaceptar_Click()
' primero borramos los datos de la tabla para ser actualizado con los que se leyeron
Dim sQuery As String
Dim dContador As Double
Dim iContador As Integer
sQuery = "DELETE consar"
goCnx.BeginTrans
If Not Err Then
goCnx.Execute sQuery
If Not Err Then
goCnx.CommitTrans
Else
goCnx.RollbackTrans
MsgBox "Error al borrar datos", vbCritical, "Error de Datos"
End If
Else
MsgBox "Error al procesar los datos, no se pudo concluir la operación...", vbCritical, "Error de Datos"
Exit Sub
End If
goCnx.BeginTrans
If Not Err Then
' procesamos todos los datos del spread para insertarlos en la tabla "CONSAR"
For dContador = 1 To Me.sprCuentas.MaxRows
Me.sprCuentas.Row = dContador
Me.Label1.Caption = "Registros Procesados: " & Format$(dContador, "###,##0") & "/" & Format$(Me.sprCuentas.MaxRows, "###,##0")
DoEvents
sQuery = "insert into consar(rfc,curp,cedula_imss,paterno,materno,nombre,clave_pagaduria,clave_reparto,fecha_nacimiento,entidad_nacimiento,sexo,estado_civil,domicilio,localidad,poblacion,codigo_postal,entidad_federativa,nombramiento,icefa,control_interno,empleado,fecha_alta,fecha_ingreso,sueldo_basico_cotizacion,sueldo_basico_vivienda,salario_integrado,dias_laborados,credito_fovissste)"
sQuery = sQuery & " values("
For iContador = 1 To 28
Me.sprCuentas.Col = iContador
Select Case iContador
Case 7, 12, 16, 18, 19, 24, 25, 26, 27
sQuery = sQuery & Me.sprCuentas.Value & ","
Case 9, 22, 23
sQuery = sQuery & "'" & Format$(Me.sprCuentas.Text, "YYYYMMDD") & "',"
Case Else
sQuery = sQuery & "'" & Me.sprCuentas.Text & "',"
End Select
Next iContador
sQuery = Left$(sQuery, Len(sQuery) - 1) & ")"
' ahora procesamos el insert en la base datos
goCnx.Execute sQuery
If Err Then
goCnx.RollbackTrans
End If
Next dContador
goCnx.CommitTrans
Else
MsgBox "Error al procesar los datos, no se pudo concluir la operación...", vbCritical, "Error de Datos"
Exit Sub
End If
MsgBox "Los datos de CONSAR se insertaron con éxito en la base de datos...", vbInformation, "Inserción de Datos"
Me.Label1.Caption = ""
End Sub
