神剑山庄资源网 Design By www.hcban.com
复制代码 代码如下:
'脚本说明
'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
'脚本说明
'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
神剑山庄资源网 Design By www.hcban.com
神剑山庄资源网
免责声明:本站文章均来自网站采集或用户投稿,网站不提供任何软件下载或自行开发的软件!
如有用户或公司发现本站内容信息存在侵权行为,请邮件告知! 858582#qq.com
神剑山庄资源网 Design By www.hcban.com
暂无excel2access vbs脚本的评论...
P70系列延期,华为新旗舰将在下月发布
3月20日消息,近期博主@数码闲聊站 透露,原定三月份发布的华为新旗舰P70系列延期发布,预计4月份上市。
而博主@定焦数码 爆料,华为的P70系列在定位上已经超过了Mate60,成为了重要的旗舰系列之一。它肩负着重返影像领域顶尖的使命。那么这次P70会带来哪些令人惊艳的创新呢?
根据目前爆料的消息来看,华为P70系列将推出三个版本,其中P70和P70 Pro采用了三角形的摄像头模组设计,而P70 Art则采用了与上一代P60 Art相似的不规则形状设计。这样的外观是否好看见仁见智,但辨识度绝对拉满。
更新日志
2024年06月27日
2024年06月27日
- 瑞鸣音乐《中国音乐地图之听见河南豫剧经典唱段》2020[WAV分轨]
- 【伊比萨沙发】VA-2024-IbizaSpring2024(LoungeCocktailsfromtheHeart)[FLAC]
- 群星《世界顶级汽车音响试音王》4K金碟16CD[WAV+CUE]
- 群星-音效环绕天碟《极致环绕人声天碟天品》7CD[WAV]
- 泰拉克SACD古典试音碟7SACD-ISO
- 群星《红歌宝典》20CD[WAV/分轨]
- 《101系列:好歌101首 细听年代精选》[WAV+CUE][3.6GB]
- 《101系列 6CD 国语经典101首歌曲 张学友 王菲代表作》[APE+CUE][2.8GB]
- 《101系列:国语经典101 VOL2 6CD 精选最经典101首》[WAV+CUE][2.3GB]
- 群星《十年网络红歌》15CD[WAV分轨]
- 宝丽金-环球10周年至50周年经典金曲15CD[低速原抓WAV+CUE]
- FIM唱片《十大男伶》[低速原抓WAV+CUE]
- 《101系列:情歌101 6CD》[WAV+CUE][3.1GB]
- 庄心妍《降调版合集》[320K/MP3][52.96MB]
- 庄心妍《降调版合集》[FLAC/分轨][118.78MB]