Private conexion_AS400 As New ADODB.Connection
Private lectura_escritura_AS400 As New ADODB.Command
Private registros_AS400 As ADODB.Recordset

Private conexion_SQL_SERVER As New ADODB.Connection
Private lectura_escritura_SQL_SERVER As New ADODB.Command
Private registros_SQL_SERVER As ADODB.Recordset

Private xqry As String

Private FOR1 As Integer
Private NUMERO_DE_CAMPOS As Integer

Private FICHERO_SQL As String
Private FICHERO_AS400 As String
Private BASE_DATOS_SQL As String
Private BASE_DATOS_AS400 As String

Private CAMPOS_DEL_FICHERO(1000) As String
Private TIPO_DE_CAMPO(1000) As String
Private BASURA1 As String
Private V As Integer

Private registros_procesados As Long

Option Explicit



Private Sub Form_Load()

    '-------------------
    'CONECTAR CON BASE DE DATOS AS 400
    '-------------------
    conexion_AS400.Open "Provider=IBMDA400;Data Source=xxx.xxx.xxx.xxx;", "", ""
    Set lectura_escritura_AS400.ActiveConnection = conexion_AS400
    ‘ojo el as400 te pide usuario y contraseña    
    '-------------------
    'CONECTAR CON BASE DE DATOS SQL SERVER
    '-------------------
    conexion_SQL_SERVER.Open "Provider=SQLOLEDB;network librari=DBMSSOCN; Data Source=nombre_base_de_datos ; initial catalog=master; user id=usuario_sql; password=contraseña_sql; "
    Set lectura_escritura_SQL_SERVER.ActiveConnection = conexion_SQL_SERVER
        

    
                    BASE_DATOS_SQL = "DBSQL" ‘nombre supuesto
                    BASE_DATOS_AS400 = "LIB400"‘nombre supuesto
                    FICHERO_SQL = "TABLASQL"‘nombre supuesto
                    FICHERO_AS400 = "FICHERO400"‘nombre supuesto

    'borrado del fichero
    '-------------------
    xqry = "DELETE FROM " & BASE_DATOS_SQL & ".." & FICHERO_SQL
    lectura_escritura_SQL_SERVER.CommandText = xqry
    lectura_escritura_SQL_SERVER.Parameters.Refresh
    lectura_escritura_SQL_SERVER.Prepared = True
    Set registros_SQL_SERVER = lectura_escritura_SQL_SERVER.Execute
    
    'leer campos del fichero en sql
    '-------------------
    xqry = "SELECT * FROM " & BASE_DATOS_SQL & ".." & FICHERO_SQL
    lectura_escritura_SQL_SERVER.CommandText = xqry
    lectura_escritura_SQL_SERVER.Parameters.Refresh
    lectura_escritura_SQL_SERVER.Prepared = True
    Set registros_SQL_SERVER = lectura_escritura_SQL_SERVER.Execute
    
    Erase CAMPOS_DEL_FICHERO
    Erase TIPO_DE_CAMPO
    NUMERO_DE_CAMPOS = 0
    

    'recuperar del fichero el nombre del campo y el tipo
    '-------------------
    For FOR1 = 0 To (registros_SQL_SERVER.Fields.Count) - 1
        CAMPOS_DEL_FICHERO(FOR1 + 1) = registros_SQL_SERVER.Fields(FOR1).Name
        If registros_SQL_SERVER.Fields(FOR1).Type = adChar Or registros_SQL_SERVER.Fields(FOR1).Type = adLongVarChar Or registros_SQL_SERVER.Fields(FOR1).Type = adVarChar Or registros_SQL_SERVER.Fields(FOR1).Type = adVarWChar Or registros_SQL_SERVER.Fields(FOR1).Type = adWChar Then
            TIPO_DE_CAMPO(FOR1 + 1) = "A"
        Else
            TIPO_DE_CAMPO(FOR1 + 1) = "N"
        End If
        If Trim(CAMPOS_DEL_FICHERO(FOR1 + 1)) = "" Then Exit For
        NUMERO_DE_CAMPOS = NUMERO_DE_CAMPOS + 1
    Next
    

    'leer del AS/400
    '-------------------
    xqry = "SELECT * FROM " & BASE_DATOS_AS400 & "." & FICHERO_AS400
    lectura_escritura_AS400.CommandText = xqry
    lectura_escritura_AS400.Parameters.Refresh
    lectura_escritura_AS400.Prepared = True
    Set registros_AS400 = lectura_escritura_AS400.Execute
    
    Do While Not registros_AS400.EOF
        'preparar sentecia de grabacion
        '-------------------
        xqry = "INSERT INTO " & BASE_DATOS_SQL & ".." & FICHERO_SQL & " ("
        For FOR1 = 1 To NUMERO_DE_CAMPOS
            xqry = xqry & CAMPOS_DEL_FICHERO(FOR1)
            If FOR1 < NUMERO_DE_CAMPOS Then xqry = xqry & ", "
        Next
        
       xqry = xqry & ") VALUES ("
       
        For FOR1 = 1 To NUMERO_DE_CAMPOS
            'PASAR VALOR A CAMPO DE TRABAJO
            '-------------------
            BASURA1 = registros_AS400(CAMPOS_DEL_FICHERO(FOR1))
            'PONER PUNTO DECIMAL
            '-------------------
            If TIPO_DE_CAMPO(FOR1) = "N" Then
                V = InStr(BASURA1, ",")
                If V > 0 Then
                        Mid$(BASURA1, V, 1) = "."
                End If
            End If
            'QUITAR APOSTROFE
            '-------------------
            If TIPO_DE_CAMPO(FOR1) = "A" Then
                V = InStr(BASURA1, "'")
                Do While V > 0
                        Mid$(BASURA1, V, 1) = "´"
                         V = InStr(BASURA1, "'")
                Loop
            End If
            If TIPO_DE_CAMPO(FOR1) = "A" Then xqry = xqry & "'"
            xqry = xqry & BASURA1
            If TIPO_DE_CAMPO(FOR1) = "A" Then xqry = xqry & "'"
            If FOR1 < NUMERO_DE_CAMPOS Then xqry = xqry & ", "
        Next
        xqry = xqry & ")"
         
        registros_procesados = registros_procesados + 1
        mensaje.Caption = "Procesando Fichero " & FICHERO_AS400 & " en " & BASE_DATOS_SQL & " Número de Registros Leidos.:" & registros_procesados
        mensaje.Refresh

        'grabar en sql
        '-------------------
        On Error Resume Next
        lectura_escritura_SQL_SERVER.CommandText = xqry
        lectura_escritura_SQL_SERVER.Parameters.Refresh
        lectura_escritura_SQL_SERVER.Prepared = True
        Set registros_SQL_SERVER = lectura_escritura_SQL_SERVER.Execute
        If Err <> 0 Then
            MsgBox (" " & Str(Err.Number) & Chr$(13) & Err.Description)
        End If
        On Error GoTo 0
        
        'leer siguiente del as400
        '-------------------
        On Error Resume Next
        registros_AS400.MoveNext
        If Err <> 0 Then
            MsgBox (" " & Str(Err.Number) & Chr$(13) & Err.Description)
            Exit Do
        End If
        On Error GoTo 0
    Loop
    
    
End Sub