vrijdag, november 08, 2013

Excel to SQL

Right. This is still a work in progress -- and if any of you super-savvy coders lend a hand, I'll be most appreciative -- until such time, here is MY very own script to upload data from Excel to SQL.


Be careful when you use this though, it's not finished by a LONG shot.

Some pre-requisites:

1) Column names better not contain too many special characters
2) the tab of your excel document should be equal to the name of the table


Just paste this code into notepad and save as excelToSQL.vbs

modify the settings for the connectionString and you're all set.

Drag an excel file on top of this script and watch..

Shortcomings

The script has a VERY rudementary detection of column-type and length -- it's something I'll be developing in more detail later.

Dates are uploaded as-is -- that's a really bad one, because month and day inversion are quite likely.

Decimal values are uploaded as-is -- if there is a discrepancy between your excel and the sql -- good luck to you, the data will, or create an error, or upload wrongly.

And yes, I AM aware that I use global variables inside my functions -- I had some problems passing objects to functions or I wouldn't have.


so, handle with care and enjoy.


'-----------------------------
' excelToSQL.vbs
' Purpose : transfer an excel file to a SQL server.
' Use : drag 1 Excel file over the script and the data is transferred/
' Author: Peter De Rop
' Date: 2013/11/8
if WScript.Arguments.Count > 1 Then
  WScript.Echo "Error! Please specify the source path and the destination. Usage: excelToSQL SourcePath.xls"
  Wscript.Quit
else
    ' get timer before task begins:

    starttime = Timer()
'define variables
dim objExcel, objWorkbook, objWorksheet, iXMax, objConn, objRS, bAppend, strTablename
dim arrColNames()
dim arrColTypes()

'set objects
set objExcel = createobject("Excel.Application")
set objWorkbook = objExcel.workbooks.open(wscript.arguments(0))
set objWorksheet = objWorkbook.worksheets(1)
strTablename = replace(objWorksheet.name, " ", "")
set objConn = createobject("ADODB.CONNECTION")

bAppend = false
objConn.connectionstring="DRIVER=SQL Server;Server=yoursqlserver;Database=database;User Id=userid;Password=password;"
objConn.open

'obtain the names, types and lengths of the columns to create
        fnObtainColumnNames()
' check if the table exists or not -- ask to append, if the table already exists, if no, drop the table
set objRS = createobject("ADODB.Recordset")
objRS.activeconnection = objConn
q = "select count(table_name) as iTable from information_schema.tables where table_name='" & objWorksheet.name & "'"
objRS.open q,,1,1
if objRS.fields("iTable").value > 0 then
        if msgbox("Drop the existing table?",vbQuestion+vbYesNo,"") = vbYes  then
                q = "drop table " & objWorksheet.name
                objRS.close
                objRS.open q,, 1,3
               
                if msgbox("Store the data?",vbQuestion+vbYesNo,"") = vbYes then
                        fnObtainTypeAndLength()
                        q = fnAssembleQuery()
                        objRS.open q,, 1, 3
                        fnStoreData()
                end if
        else
                fnStoreData()
        end if
else
        fnObtainTypeAndLength()
        q = fnAssembleQuery()
        objRS.close
        file.writeline q
        objRS.open q,, 1, 3
        fnStoreData()
end if

' convert the data to the right type if needed

'close excel document
        objWorkbook.close
        objExcel.quit
        set objWorkbook = nothing
        set objExcel = nothing
        ' get timer after task completes:
    endtime = Timer()

    ' display results:
        msgbox "The task completed in " & endtime-starttime & " s"

end if

' fnObtainColumnNames(oWS)
' Purpose: this function will run through the first line of the excel worksheet and obtain each of the column names.
' it will clean them up and store them in an array.

function fnObtainColumnNames()
        dim iX, iY
        iX = 1
        iY = 1
        iXMax = 1
        do until objWorksheet.cells(iY, iX) = ""
                iXMax = iXMax + 1
                iX = iX + 1
        loop
        redim arrColNames(iXMax)
        iX = 1
        do until objWorksheet.cells(iY, iX) = ""
                arrColNames(iX) = replace(replace(replace(replace(objWorksheet.cells(iY, iX), " ", ""), "+", ""), "(", ""), ")", "")
                iX = iX + 1
        loop
end function

' fnObtainType
' Purpose: this function will run through all columns and determine what the type of each column needs to be.
' It will then store this information in an array of types

function fnObtainTypeAndLength
        dim iX, iY, iMaxLen, iType
        iX = 1
        iY = 2
       
        redim arrColTypes(iXMax)
        for iX = 1 to iXMax
                iMaxLen = 0
                iY = 2
                do until iY = 10       
                        iType = vartype(objWorksheet.cells(iY, iX))
                        if len(objWorksheet.cells(iY, iX)) < iMaxLen then
                                iMaxLen = len(objWorksheet.cells(iY, iX))
                        end if
                        iY = iY + 1
                loop
                if iType = 8 or iType = 0 or iType = 1 or iType = 12 then
                        arrColTypes(iX) = fGetType(iType) & "(" & iMaxLen + 100 & ")"
                else
                        arrColTypes(iX) = fGetType(iType)
                end if
        next
end function


Function fGetType(vType)
    Select Case vType  
        Case 0 fGetType = "varchar"
        Case 1 fGetType = "varchar"
        Case 2 fGetType = "int"
        Case 3 fGetType = "Float"
        Case 4 fGetType = "Float"
        Case 5 fGetType = "Float"
        Case 6 fGetType = "Float"
        Case 7 fGetType = "datetime"
        Case 8 fGetType = "varchar"
                Case 9 fGetType = "varchar"
                Case 10 fGetType = "varchar"
        Case 11 fGetType = "int"
        Case 12 fGetType = "varchar"
                Case 13 fGetType = "varchar"
        Case 14 fGetType = "Float"
        Case Else fGetType = "undetected"
    End Select
End Function


' purpose : assemble the table creation query
' fnAssembleQuery
function fnAssembleQuery
        strQuery = "create table " & strTablename & " ("
        iCount = 1
        do while iCount <= ubound(arrColNames)-1
                if iCount < ubound(arrColNames)-1 then
                        strQuery = strQuery & "F_" & arrColNames(iCount) & " " & arrColTypes(iCount) & ","
                else
                        strQuery = strQuery & "F_" & arrColNames(iCount) & " " & arrColTypes(iCount)
                end if
                iCount = iCount + 1
        loop
        strQuery = strQuery & ")"
        fnAssembleQuery = strQuery
end function

' purpose: run through the excel file line by line, column by column
' fnStoreData
' once the table has been created, the data needs to be uploaded.
function fnStoreData
        q = "select * from " & strTablename
        set oStoreData = createobject("ADODB.recordset")
        oStoreData.activeconnection = objConn
        oStoreData.open q,,1,3
        iXStore = 1
        iYStore = 2

        with oStoreData
                do until objWorksheet.cells(iYStore, 1) = ""
                        .addNew
                        for iCol = 1 to ubound(arrColNames)-1
                                .fields("F_" & arrColNames(iCol)) = objWorksheet.cells(iYStore, iCol)
                        next
                        .update
                        iYStore = iYStore + 1
                loop
        end with

end function