首页 电脑 电脑学堂 查看内容

excel2access vbs脚本

2009-9-23 17:24 582 0

摘要:   将excel的数据转化为access的数据库中的方法。   代码如下:   '脚本说明   'code by NP   'outDateFile变量为要写入的数据库名字   'Table...

  将excel的数据转化为access的数据库中的方法。   代码如下:   '脚本说明   '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
声明:文章版权归原作者所有 部分文章转自互联网 如有侵权请联系 [邮箱地址] 删除

路过

雷人

握手

鲜花

鸡蛋

最新评论

返回顶部