Dim filename,sheetname Dim xlAppDim xlWorkbookDim xlWorksheet Dim i,constr,con,rst,iRowCountfilename= '此处填写要导入excel的完整文件路径If filename="" Then Msgbox "还没有选择需要导入的文件!"Elsesheetname ='此处填写的是excel表重要导入的sheet名字Dim e '确认是否更新e=Msgbox("你即将导入'"& filename &"'的数据到 ERS点 数据表中，请再次确认！",vbOKCancel)If e=vbOk Then constr="Provider=SQLOLEDB.1;Password=pwd;Persist Security Info=True;User ID=userName;Initial Catalog=databaseName;Data Source=127.0.0.1" '在wincc里面的时候要在链接ip后面加上 /winccSet con = CreateObject("ADODB.Connection")con.ConnectionString = constrcon.OpenIf Con.State = 0 Then'判断数据库连接是否成功' MsgBox "连接数据库失败"ElseMsgBox "连接数据库成功"End IfSet xlApp=CreateObject("Excel.Application")Set xlWorkBook=xlApp.Workbooks.Open(filename)xlApp.Visible=TrueSet xlWorksheet=xlWorkBook.WorkSheets(sheetname)xlWorkBook.WorkSheets(sheetname).ActivateiRowCount = xlWorksheet.usedRange.Rows.Count '获取sheet中有内容的Rowcount行数If iRowCount<=1 ThenMsgBOX "表中不存在数据，请检查~"Else'此处我用的是直接请空数据库con.Execute "truncate table initial_coordinates"Dim X,Y,Z,ID,point_name,X1,Y1,Z1'读取excel表中数据并且写入到数据库中For i=2 To iRowCountID=i-1X=xlWorksheet.Range("B" & i).Value Y=xlWorksheet.Range("C" & i).ValueZ=xlWorksheet.Range("D" & i).Valuepoint_name=xlWorksheet.Range("A" & i).ValueX1=xlWorksheet.Range("E" & i).ValueY1=xlWorksheet.Range("F" & i).ValueZ1=xlWorksheet.Range("G" & i).Valuecon.Execute "insert into initial_coordinates values(N'"& ID &"',N'"& point_name &"',"& X &","& Y &","& Z &","& X1 &","& Y1 &","& Z1 &")"NextMsgBox "数据已经导入成功！"If con.state Then con.Close '关闭数据连接Set xlWorkBook=NothingSet xlApp=NothingEnd IfElse End ifEnd if
