华域联盟 vbs excel2access vbs脚本

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


您可能感兴趣的文章:

本文由 华域联盟 原创撰写:华域联盟 » excel2access vbs脚本

转载请保留出处和原文链接:https://www.cnhackhy.com/15728.htm

本文来自网络,不代表华域联盟立场,转载请注明出处。

作者: sterben

发表回复

联系我们

联系我们

2551209778

在线咨询: QQ交谈

邮箱: [email protected]

工作时间:周一至周五,9:00-17:30,节假日休息

关注微信
微信扫一扫关注我们

微信扫一扫关注我们

关注微博
返回顶部