RESPUESTA A LA PREGUNTA 5205


EXIGE QUE SE INFORME RUTA Y NOMBRE DEL ARCHIVO EXCEL Y EL RANGO A TRATAR DE LA PLANILLA/HOJA DE DICHO ARCHIVO....

AL FIN Y AL CABO, LO MAS IMPORTANTE, ES LA CONEXION UTILIZADA (ODBC) !!!!!!!
================================================

Sub ExcelAAccess(sRutaNombreExcel As String, sArchivoExcel As String, sRangoExcel As String, sBaseAccess)
Dim ExcelConexion As ADODB.Connection
Dim ExcelRs As ADODB.Recordset
Dim ExcelConexionString As String
Dim AccessConexion As ADODB.Connection
Dim AccessRs As ADODB.Recordset
Dim sTabla As String
Dim iCampo As Integer
Dim sSQL As String
Dim iRegistro As Integer

    '----------------------------CONEXION EXCEL-------------------------------------
    ExcelConexionString = "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & sRutaNombreExcel
    Set ExcelConexion = New ADODB.Connection
    ExcelConexion.Open ExcelConexionString ' open the database connection
    Set ExcelRs = ExcelConexion.Execute("[" & sRangoExcel & "]")
    
    '----------------------------CONEXION ACCESS-------------------------------------
    Set AccessConexion = New ADODB.Connection
    AccessConexion.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & sBaseAccess & ";"
    Set AccessRs = New ADODB.Recordset
    AccessRs.CursorType = adOpenKeyset
    AccessRs.LockType = adLockOptimistic
            
    sTabla = Mid(sArchivoExcel, 1, (InStr(1, sArchivoExcel, ".")) - 1)
    
    'Borro el contenido de la tabla SUP_PRIC
    sSQL = "DELETE * FROM " & sTabla
    AccessConexion.Execute sSQL
        
    If Not ExcelRs.EOF Then
        'Extraigo los nombres de campo
        For iCampo = 0 To ExcelRs.Fields.Count - 1
            ReDim Preserve atPrecios(iCampo)
            atPrecios(iCampo).sNombre = ExcelRs.Fields(iCampo).Name
        Next iCampo
                
        ExcelRs.MoveNext
        
        'Leo datos de Excel (SUP_PRIC.XLS) y los paso a la tabla SUP_PRIC de Access
        Do While Not ExcelRs.EOF
            
            For iCampo = 0 To ExcelRs.Fields.Count - 1
                atPrecios(iCampo).vValor = ExcelRs(iCampo)
            Next iCampo
            
            'Armo el SQL
            sSQL = ArmaSQL()
                        
            'Lo ejecuto
            AccessConexion.Execute sSQL
                    
            iRegistro = iRegistro + 1
            txtRegistro = iRegistro
            Me.Refresh
            
            'Paso al siguiente registro
            ExcelRs.MoveNext
        Loop
    Else
        MsgBox "EL ARCHIVO EXCEL ESTA VACIO O NO EXISTE !!!"
    End If
    '----------------------------FIN CONEXION EXCEL-------------------------------------
    ExcelConexion.Close ' close the database connection
    Set ExcelRs = Nothing
    Set ExcelConexion = Nothing
    
    '----------------------------FIN CONEXION ACCESS-------------------------------------
    Set AccessRs = Nothing
    AccessConexion.Close
    Set AccessConexion = Nothing
    
Exit Sub
End Sub


Diego Guida
dguida@se.com.ar