La macro que presentamos ha sido elaborada para permitir, de forma sencilla y rápida, importar una o más hojas de cálculo de un libro Excel (.xls o .xlsx) a OpenOffice Base.

Cada hoja del libro de Excel es analizada, y si contiene datos, la macro intentará detectar correctamente el tipo de datos de cada columna; posteriormente se creará una tabla en la base de datos con el mismo nombre que tiene la pestaña de la hoja de cálculo, a la que se importarán los datos.

Importará todas las hojas, creando una tabla por cada hoja encontrada. A cada nueva tabla se le agregará también un campo autonumérico como clave primaria.

La macro se ha elaborado utilizando código recogido en la web http://www.baseprogramming.com/resources.html, correspondiente al libro de Roberto Benitez Database Programming with OpenOffice.org Base & Basic, y ha sido adaptada por el equipo de open-office.es.

El código contiene modificaciones que hacen que:

• Si la tabla a crear coincide en nombre con una ya existente, se crea agregando al nombre un número secuencial, al estilo Tabla_1, Tabla_2, ... Tabla_68, etc.
• Los campos de tipo texto se crean con 255 carácteres de longitud
• Los campos numéricos se crean como de tipo Double

La macro ha sido probada con hojas de cálculo tanto con extensión .xls como .xlsx, utilizando en cada caso el argumento cExt adecuado ("xls" o "xlsx").

Garantía de uso y responsabilidades

La macro se ofrece sin garantía alguna de su funcionamiento. Cualquiera que pueda ser el daño ocasionado por su uso es de su completa responsabilidad. Recomendamos realizar copias de seguridad de los datos y bases de datos previamente a su uso. No se ofrece garantía alguna sobre su funcionamiento, si bien, publicamos el código de buena fe y con la convicción de que funciona correctamente. El código de la macro está sujeto a la licencia ofrecida por el autor del libro, indicada en el mismo.

El código

' Importa una o varias hojas de cálculo Excel (.xls) completa a la base de datos
' Este código está en fase EXPERIMENTAL
' Si lo utiliza es bajo su propio riesgo
' Haga copia de seguridad de sus datos antes de utilizarlo
' No nos hacemos responsables de ningún tipo de daño provocado por el uso de este software

' Basado en el material recogido de http://www.baseprogramming.com/resources.html
' de Roberto C. Benitez
' forma parte de su libro Database Programming with OpenOffice.org Base & Basic
' que se puede encontrar en la web Lulú
' http://www.lulu.com/shop/roberto-benitez/database-programming-with-openofficeorg-base-basic/paperback/product-3568728.html
' Licencia sujeta a la expresada por el autor del libro
' Adaptado por SLV-es
' Idea tomada del tema en el Foro Español de Apache OpenOffice http://forum.openoffice.org/es/forum/viewtopic.php?f=31&t=845&p=2516

' EJEMPLO DE USO:
' ImportarHojaCalculo("C:\","datos","xsl","NombreMiBaseDeDatosRegistrada", "ruta-completa-base-datos" )


Sub Main
    ' ImportarHojaCalculo("X:\","CLIENTES", "xls", "BaseDeDatos", "X:\BaseDeDatos.odb")
    ' MsgBox "Proceso terminado"
End Sub
    
    
Function ImportarHojaCalculo(cRuta As String, cArchivo As String, cExt As String, cBaseDeDatos As String, cRutaBdD As String)
    ' Excel < 2007
    ' ImportarHojaCalculo("C:\","datos","xsl","NombreMiBaseDeDatosRegistrada", "ruta-completa-base-datos" )
    
    ' Excel >= 2007
    ' ImportarHojaCalculo("C:\","datos","xslx","NombreMiBaseDeDatosRegistrada", "ruta-completa-base-datos" )
    
    Dim oHojas As Object ' Spreadsheet Tables
    Dim cHoja As String
    Dim oContenido As Object
    Dim i As Integer

    oHojas=LeeHojas(cRuta,cArchivo,cExt) ' get the tables

    For i=0 To oHojas.Count-1
        cHoja=oHojas.ElementNames(i)
        oContenido=LeeDatosHoja(cRuta,cArchivo,cExt,i)
        CreaTabla( oContenido,cBaseDeDatos,cHoja)
        EscribeDatosTabla(oContenido,cRutaBdD,cHoja)
    Next i
    oContenido.Close()

    ImportarHojaCalculo = True
End Function


Function LeeHojas(strPath As String, strFileName As String, strExt As String) As Object
    ' GET THE TABLES FOR THIS SPREADSHEET DATADEFINITION--FROM DRIVER
    Dim Manager As Object
    Dim Driver As Object
    Dim Tables As Object
    Dim strFile As String
    Dim Params(1) As New com.sun.star.beans.PropertyValue
    strFile=strPath & strFileName &  "." &  strExt
    strURL="sdbc:calc:" & ConvertToURL(strFile)

    DriverManager = CreateUNOService("com.sun.star.sdbc.DriverManager")
    Driver=DriverManager.getDriverByURL(strURL)

    If IsNull(Driver) Then
        Exit Function
    End If
    Params(0).Name="Extension"
    Params(0).Value=strExt
    Params(1).Name="HeaderLine"
    Params(1).Value=True

    LeeHojas=Driver.getDataDefinitionByUrl(strURL,Params()).Tables
End Function


Function LeeDatosHoja(strPath As String, strFileName As String, _
    strExt As String, Optional Sheet As Integer) As Object
    Dim Manager As Object
    Dim Driver As Object
    Dim Conn As Object
    Dim Stmt As Object
    Dim strSQL As String
    Dim strFile As String
    Dim strURL As String
    Dim Params(2) As New com.sun.star.beans.PropertyValue
    Dim strQuote As String
    Dim strTableName As String
    Dim Tables As Object

    If IsMissing(Sheet) Then
        Sheet=0
    End If
    strFile=strPath & strFileName &  "." &  strExt
    strURL="sdbc:calc:" & ConvertToURL(strFile)

    DriverManager = CreateUNOService("com.sun.star.sdbc.DriverManager")
    Driver=DriverManager.getDriverByURL(strURL)

    If IsNull(Driver) Then
        MsgBox "Error. Driver not found"
        Exit Function
    End If
    Params(0).Name="Extension" : Params(0).Value=strExt
    Params(1).Name="HeaderLine" : Params(1).Value=True

    Conn=Driver.Connect(strURL,Params)

    Tables=Driver.getDataDefinitionByConnection(Conn).Tables
    Stmt=Conn.createStatement()
    Stmt.ResultSetType=1004
    strQuote=Conn.getMetaData().getIdentifierQuoteString()
    strTableName=strQuote & Tables.ElementNames(Sheet) & strQuote
    strSQL="SELECT * FROM " & strTableName
    LeeDatosHoja=Stmt.executeQuery(strSQL)
End Function


Sub CreaTabla(ResultSet As Object, DataSourceName As String, _
    Optional TableName As String, Optional PKColumn As Integer, _
    Optional UserName As String, Optional Password As String)
    Dim Context As Object
    Dim DB As Object
    Dim Conn As Object
    Dim Tables As Object
    Dim Columns As Object
    Dim Keys As Object
    Dim KeyColumns As Object
    Dim TableDescriptor As Object
    Dim ColumnDescriptor As Object
    Dim KeyDescriptor
    Dim DataTypes As Object
    Dim ColumnValues As Object
    Dim KeyTypes As Object
    Dim i As Integer
    Dim Precision As Long
    Dim PKName As String

    Context=CreateUNOService("com.sun.star.sdb.DatabaseContext")
    DB=Context.getByName(DataSourceName)
    If IsMissing(TableName) OR IsNull(TableName) OR Left(TableName,5)="Error" Then
        TableName=ResultSet.MetaData.getTableName(1)
    End If
    If IsMissing(UserName) Then
        UserName=""
    End If
    If IsMissing(Password) Then
        Password=""
    End If
    Conn=DB.getConnection(UserName,Password)
    Tables=Conn.Tables

    ' CREATE DESCRIPTOR
    ' Modificado por SLV-es
    Dim n As Integer, c As String
    n = 1
    c = ""
    Do While True
        If Tables.hasByName(TableName & c) Then
            c = "_" & n
            n=n+1
        Else
            TableName = TableName & c
            Exit Do
        End If
    Loop
    ' Fin de modificación

    TableDescriptor=Tables.createDataDescriptor()
    TableDescriptor.Name=TableName
    Columns=TableDescriptor.Columns

    If IsMissing(PKColumn) OR (PKColumn<0 OR PKColumn>=ResultSet.MetaData.getColumnCount() )  Then
        PKColumn=-1
    End If

    DataTypes=com.sun.star.sdbc.DataType
    ColumnValues=com.sun.star.sdbc.ColumnValue
    KeyTypes=com.sun.star.sdbcx.KeyType

    If PKColumn<0 Then
        ColumnDescriptor=Columns.createDataDescriptor()
        PKName=TableName & "_PK"
        With ColumnDescriptor
        .Name=PKName
        .Type=DataTypes.INTEGER
        .IsNullable=ColumnValues.NO_NULLS
        .IsAutoIncrement=True
    End With
    Columns.appendByDescriptor(ColumnDescriptor)
    Else
        PKName=ResultSet.MetaData.getColumnName(PKColumn)
    End If

    Dim tt,nn

    For i=1 To ResultSet.MetaData.getColumnCount()
        ColumnDescriptor=Columns.createDataDescriptor() ' Just reset every time
        With ColumnDescriptor
        .Name=ResultSet.MetaData.getColumnName(i)
        .Type=ResultSet.MetaData.getColumnType(i)

        ' modificado SLV-es
        If .Type = 3 Then .Type = 8 ' forzar números tipo decimal a double
        ' http://docs.oracle.com/javase/1.4.2/docs/api/constant-values.html#java.sql.Types.DOUBLE
        ' fin modificación

        .IsNullable=ResultSet.MetaData.isNullable(i)
        .Description=ResultSet.MetaData.getColumnLabel(i)
        .IsAutoIncrement=ResultSet.MetaData.isAutoIncrement(i)
        .IsCurrency=ResultSet.MetaData.isCurrency(i)
        Precision=ResultSet.MetaData.getPrecision(i)
        If precision<1 Then
            Precision=5
        End If

        ' modificado SLV-es
        If .type = 1 OR .type = 12 Then Precision = 255 ' forzar tipo texto a 255 de longitud
        ' fin modificación

        .Precision=Precision
        .Scale=ResultSet.MetaData.getScale(i)
        .Width=ResultSet.MetaData.getColumnDisplaySize(i)
    End With
    Columns.appendByDescriptor(ColumnDescriptor)
    Next i

    ' CREATE KEY
    Keys=TableDescriptor.Keys
    KeyDescriptor=Keys.createDataDescriptor()
    KeyDescriptor.Type=KeyTypes.PRIMARY
    KeyDescriptor.Name=PKName
    KeyColumns=KeyDescriptor.Columns
    ColumnDescriptor=KeyColumns.createDataDescriptor()
    ColumnDescriptor.Name=PKName
    KeyColumns.appendByDescriptor(ColumnDescriptor)
    Keys.AppendByDescriptor(KeyDescriptor)

    ' Finally, append table to table supplier
    Tables.appendByDescriptor(TableDescriptor)
    Conn.Close()
End Sub


Sub EscribeDatosTabla(Result As Object, ByVal cRutaBdD As String, _
    Optional ByVal TableName As String, Optional ShiftTargetIndex As Boolean )
    ' IMPORT CONTENTS OF RESULTSET
    ' ASSUMES THAT THERE IS A 1-TO-1 COLUMN RELATIONSHIP-->ith column of source is exactly the same as ith column
    ' of the target.
    ' i have added the ShiftTargetIndex in case an auto incrementing column has been added and the
    ' source does not have a value for that column
    Dim RowSet As Object
    Dim TargetCol As  Object
    Dim i As Integer
    Dim tmpVal As Variant
    Dim J As Integer
    Dim ColIndex As Integer

    If IsMissing(ShiftTargetIndex) Then
        ShiftTargetIndex=False
    End If
    If IsMissing(TableName) Then
        TableName=Result.MetaData.getTableName(0)
    End If
    RowSet=CreateUNOService("com.sun.star.sdb.RowSet")
    With RowSet
    .DataSourceName=ConvertToURL( cRutaBdD )
    .CommandType=com.sun.star.sdb.CommandType.TABLE
    .Command=TableName
    .IgnoreResult=True
    .execute()
    End With
    Result.first() : Result.relative(-1)
    While Result.next()
        RowSet.moveToInsertRow()
        For J=1 To RowSet.Columns.Count-1
            tmpVal=LeeDato(Result,J)
            If ShiftTargetIndex=True Then
                ColIndex=J+2 ' modificado por SLV-es, antes era =J+1
            Else
                ColIndex=J+1 ' modificado por SLV-es, antes era =J
            End If
            ActualizaDato(RowSet,ColIndex,tmpVal)
        Next J
        RowSet.insertRow()
        Wend
        RowSet.dispose()
End Sub


Function LeeDato(ResultSet As Object, ColIndex As Integer) As Variant
        ' get the data for the column specified by ColIndex
        ' get type name from metadata
        Dim ret
        Select Case ResultSet.MetaData.getColumnTypeName(ColIndex)
        Case "ARRAY": ret=ResultSet.getArray(ColIndex)
        Case "BLOB": ret=ResultSet.getBlob(ColIndex)
        Case "BOOLEAN": ret=ResultSet.getBoolean(ColIndex)
        Case "BYTE": ret=ResultSet.getByte(ColIndex)
        Case "BYTES": ret=ResultSet.getBytes(ColIndex)
        Case "BLOB": ret=ResultSet.getClob(ColIndex)
        Case "DATE": ret=ResultSet.getDate(ColIndex)
        Case "DOUBLE": ret=ResultSet.getDouble(ColIndex)
        Case "INTEGER": ret=ResultSet.getInt(ColIndex)
        Case "LONG": ret=ResultSet.getLong(ColIndex)
        Case "DECIMAL": ret=ResultSet.getDouble(ColIndex)
        Case "NULL": ret=ResultSet.getNull(ColIndex)
        Case "OBJECT": ret=ResultSet.getObject(ColIndex)
        Case "REF": ret=ResultSet.getRef(ColIndex)
        Case "SHORT": ret=ResultSet.getShort(ColIndex)
        Case "VARCHAR": ret=ResultSet.getString(ColIndex)
        Case "TIME": ret=ResultSet.getTime(ColIndex)
        Case "TIMESTAMP": ret=ResultSet.getTimeStamp(ColIndex)
        Case Else: ret=ResultSet.getString(ColIndex) 'GIVE STRING A TRY
        End Select
        LeeDato=ret
End Function


Function ActualizaDato(RowSet As Object, ColIndex As Integer, colVal As Variant)
        ' GENERIC UPDATE FUNCTION
        ' UPDATES ROWSET COLUMN

        ' Modificado SLV-es
        Select Case VarType( colVal )
        Case 9:    RowSet.updateDate(ColIndex,colVal)  ' date
        Case 8: RowSet.updateString(ColIndex,colVal) ' string
        Case 5:    RowSet.updateDouble(ColIndex,colVal) ' double
        Case Else
            ' Fin modificado

            Select Case RowSet.MetaData.getColumnTypeName(ColIndex)
            Case "BOOLEAN": RowSet.updateBoolean(ColIndex,colVal)
            Case "BYTE": RowSet.UpdateByte(ColIndex,colVal)
            Case "BYTES": RowSet.updateBytes(ColIndex,colVal)
            Case "DATE": RowSet.updateDate(ColIndex,colVal)
            Case "DOUBLE": RowSet.updateDouble(ColIndex,colVal)
            Case "INTEGER": RowSet.updateInt(ColIndex,colVal)
            Case "LONG": RowSet.updateLong(ColIndex,colVal)
            Case "NULL": RowSet.updateNull(ColIndex,colVal)
            Case "SHORT": RowSet.updateShort(ColIndex,colVal)
            Case "VARCHAR": RowSet.updateString(ColIndex,colVal)
            Case "TIME": RowSet.updateString(ColIndex,colVal)
            Case "TIMESTAMP": RowSet.updateString(ColIndex,colVal)
            End Select

            ' Modificado SLV-es
        End Select
        ' Fin modificado
End Function 'ActualizaDato