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
Geen opmerkingen:
Een reactie posten