excel2access vbs脚本

'脚本说明
'code by np
'outdatefile变量为要写入的数据库名字
'tables变量为access数据库中的表名
'row变量为access数据库中的列名
'excel中的数据，直接为要写入的数据，不需要标题一类的
'例如：要写入数据库的列名为
' 系别|班别|姓名|学号|性别|政治面貌|出生年月|身份证号码|家庭地址|生源地毕业学校
'而excel文件中，只需要以下面的例子开头就行了
' 城建系|城建0001|韦xx|071010100111|女|团员|1981/11|451111111111111111|广西xxxxxxxxx|xxxx学校
'数据和列名要对的上号！
'脚本直接双击，更具提示操作
if wscript.arguments.count > 0 then inxlsfile = wscript.arguments(0)
if inxlsfile = "" then
inxlsfile = createobject("excel.application").getopenfilename("excel files (*.xls), *.xls")
if vartype(filename) = vbboolean then
wscript.echo "excel2access。" & vbcr & vblf & vbcr & vblf & "用法: excel2access filename.xls 或在对话框中打开excel文件。"
wscript.quit
end if
end if
outdatefile="excel2access.mdb" '要转换的数据库名字
tables="学生信息表" '要创建以及写入的表名
row="系别,班别,姓名,学号,性别,政治面貌,出生年月,身份证号码,家庭地址,生源地毕业学校" '要创建以及写入的列名,用逗号隔开
set fso=createobject("scripting.filesystemobject")
if fso.fileexists(outdatefile) then
call writemdb
else
set db = createobject("adox.catalog")
db.create("provider=microsoft.jet.oledb.4.0;data source="&outdatefile)
set adoxtable = createobject("adox.table")
adoxtable.name = tables
for each s in split(row, ",", -1, 1)
adoxtable.columns.append s,202 ' 字符串
next
db.tables.append adoxtable
set db=nothing
call writemdb
end if
set fso = nothing
sub writemdb()
set objexcel = createobject("excel.application")
set objworkbook = objexcel.workbooks.open(inxlsfile)
set conn=createobject("adodb.connection")
connstr="dbq="&outdatefile&";driver={microsoft access driver (*.mdb)};"
conn.open connstr
rows=objexcel.activesheet.usedrange.rows.count
columns=objexcel.activesheet.usedrange.columns.count
for i= 1 to rows
tmp=""
for j =1 to columns
if len(objexcel.cells(i,j).value) <> 0 then
if j<>columns then
tmp=tmp&"'"&objexcel.cells(i,j).value&"',"
else
tmp=tmp&"'"&objexcel.cells(i,j).value&"'"
'wscript.echo "insert into "&tables&"("&row&") values("&tmp&")"
conn.execute "insert into "&tables&"("&row&") values("&tmp&")"
end if
else
exit for
end if
next
next
objworkbook.close
objexcel.quit
conn.close
set conn=nothing
set objworkbook=nothing
set objexcel=nothing
wscript.echo "处理完毕，请检查是否正常导入"
end sub