VBscript读取excel表,中数据导入到SQLserver数据库里面

时间:2022-11-17 12:20:29
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