excel2access vbs腳本

    將excel的數(shù)據(jù)轉(zhuǎn)化為access的數(shù)據(jù)庫(kù)中的方法。
    代碼如下:
    '腳本說明
    'code by NP
    'outDateFile變量為要寫入的數(shù)據(jù)庫(kù)名字
    'Tables變量為Access數(shù)據(jù)庫(kù)中的表名
    'ROW變量為Access數(shù)據(jù)庫(kù)中的列名
    'Excel中的數(shù)據(jù)，直接為要寫入的數(shù)據(jù)，不需要標(biāo)題一類的
    '例如：要寫入數(shù)據(jù)庫(kù)的列名為
    ' 系別|班別|姓名|學(xué)號(hào)|性別|政治面貌|出生年月|身份證號(hào)碼|家庭地址|生源地畢業(yè)學(xué)校
    '而Excel文件中，只需要以下面的例子開頭就行了
    ' 城建系|城建0001|韋XX|071010100111|女|團(tuán)員|1981/11|451111111111111111|廣西xxxxxxxxx|xxxx學(xué)校
    '數(shù)據(jù)和列名要對(duì)的上號(hào)！
    '腳本直接雙擊，更具提示操作
    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 或在對(duì)話框中打開Excel文件。"
    WScript.Quit
    End If
    End If
    outDateFile="Excel2Access.mdb" '要轉(zhuǎn)換的數(shù)據(jù)庫(kù)名字
    Tables="學(xué)生信息表" '要?jiǎng)?chuàng)建以及寫入的表名
    Row="系別,班別,姓名,學(xué)號(hào),性別,政治面貌,出生年月,身份證號(hào)碼,家庭地址,生源地畢業(yè)學(xué)校" '要?jiǎng)?chuàng)建以及寫入的列名,用逗號(hào)隔開
    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 "處理完畢，請(qǐng)檢查是否正常導(dǎo)入"
    End Sub