Dim filename,sheetname
Dim xlApp
Dim xlWorkbook
Dim xlWorksheet
Dim i,constr,con,rst,iRowCount
filename= '此处填写要导入excel的完整文件路径
If filename="" Then
Msgbox "还没有选择需要导入的文件!"
Else
sheetname = '此处填写的是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后面加上 /wincc
Set con = CreateObject("ADODB.Connection")
con.ConnectionString = constr
con.Open
If Con.State = 0 Then '判断数据库连接是否成功
' MsgBox "连接数据库失败"
Else
MsgBox "连接数据库成功"
End If
Set xlApp=CreateObject("Excel.Application")
Set xlWorkBook=xlApp.Workbooks.Open(filename)
xlApp.Visible=True
Set xlWorksheet=xlWorkBook.WorkSheets(sheetname)
xlWorkBook.WorkSheets(sheetname).Activate
iRowCount = xlWorksheet.usedRange.Rows.Count '获取sheet中有内容的Rowcount行数
If iRowCount<=1 Then
MsgBOX "表中不存在数据,请检查~"
Else
'此处我用的是直接请空数据库
con.Execute "truncate table initial_coordinates"
Dim X,Y,Z,ID,point_name,X1,Y1,Z1
'读取excel表中数据并且写入到数据库中
For i=2 To iRowCount
ID=i-1
X=xlWorksheet.Range("B" & i).Value
Y=xlWorksheet.Range("C" & i).Value
Z=xlWorksheet.Range("D" & i).Value
point_name=xlWorksheet.Range("A" & i).Value
X1=xlWorksheet.Range("E" & i).Value
Y1=xlWorksheet.Range("F" & i).Value
Z1=xlWorksheet.Range("G" & i).Value
con.Execute "insert into initial_coordinates values(N'"& ID &"',N'"& point_name &"',"& X &","& Y &","& Z &","& X1 &","& Y1 &","& Z1 &")"
Next
MsgBox "数据已经导入成功!"
If con.state Then con.Close '关闭数据连接
Set xlWorkBook=Nothing
Set xlApp=Nothing
End If
Else
End if
End if