VBA
以前不根本没有接触过,写来试试,看了几篇基础的VBA语法,开始上手写吧
需求
- 将表格里的数据导入更新到sql server数据库中去(全删全插);
- 将表格里的数据导入更新到sql server数据库中去(增量更新)。
实现过程
- VBA连接sql server数据库(在连接其他数据库的时候需要下载对应驱动)
'定义连接对象
Dim con As ADODB.Connection
Set con = New ADODB.Connection
'连接数据库
con.ConnectionString = "Provider=SQLOLEDB;Server=127.0.0.1(主机地址);Database=XX(数据库名);Uid=sa(用户名);Pwd=3248(密码)"
con.Open
- 可以检查表格信息是否正确
Dim i As Integer
Dim flag As Integer '表格是否合格标志
Dim s As String ' 不符合要求的行数
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("表格名")
'找到工作表的最后一行
endr = Cells(Rows.Count, 1).End(xlUp).Row
flag = 0
'先校验表格是否符合要求,不符合要求就不能上传到数据库中,即设置flag为1
For i = 2 To endr
'if里设置不符合条件的情况,比如此处每行第一列的值不为数字就不符合条件,设置flag=1
If (IsNumeric(sht.Cells(i, 1)) = False) Then
'拼接不符合条件的行,用于报错提示
s = s & "," & i
flag = 1
End If
Next
3.(1) flag=1时前台提示,否则开始进行全删全插
If (flag = 1) Then
' Mid(s,2)去除s的第一个逗号,& vbCrLf为换行
MsgBox (Mid(s, 2) & "行不正确,请检查!!" & vbCrLf & "第一列必须为整数")
Else
'打开时数据库
con.Open
'先删除数据库中的数
Sql = "delete from [表名]"
'执行sql
con.Execute Sql
'开始插入到数据库中,endr为上一步中求得的工作表最后一行
For i = 2 To endr
strSQL = "INSERT INTO 表名 VALUES ('" & sht.Cells(i, 1) & "', '" & sht.Cells(i, 2) & "', '" & sht.Cells(i, 3) & "')"
con.Execute (strSQL)
Next
'关闭数据库链接,释放资源
con.Close
Set con = Nothing
End If
(2) flag=1时前台提示,否则开始进行增量更新
If (flag = 1) Then
' Mid(s,2)去除s的第一个逗号,& vbCrLf为换行
MsgBox (Mid(s, 2) & "行不正确,请检查!!" & vbCrLf & "第一列必须为整数")
Else
'连接数据库
con.Open
For i = 2 To endr
'先查询数据库有没有这行记录,没有就插入
strSQL = "if not exists (select * from 表名 where 字段名1 = '" & sht.Cells(i, 1) & "' and 字段名2='" & sht.Cells(i, 2) & "' )
INSERT INTO 表名 VALUES ('" & sht.Cells(i, 1) & "', '" & (sht.Cells(i, 2)) & "', '" & sht.Cells(i, 3) & "', '" & sht.Cells(i, 4) & "', '" & sht.Cells(i, 5) & "', '" & sht.Cells(i, 6) & "')"
con.Execute (strSQL)
Next
'关闭数据库链接,释放资源
con.Close
Set con = Nothing
End If
总代码
- 全删全插
Sub 插入数据库()
'定义连接对象
Dim con As ADODB.Connection
Set con = New ADODB.Connection
'定义查询语句
Dim strSQL As String
'定义工作表相关
Dim i As Integer
Dim flag As Integer '表格是否合格标志
Dim s As String ' 不符合要求的行数
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("表格名")
'找到工作表的最后一行
Dim endr As Integer
endr = Cells(Rows.Count, 1).End(xlUp).Row
flag = 0
'先校验表格是否符合要求,不符合要求就不能上传到数据库中,即设置flag为1
For i = 2 To endr
If (IsNumeric(sht.Cells(i, 1)) = False) Then
'拼接不符合条件的行,用于报错提示
s = s & "," & i
flag = 1
End If
Next
If (flag = 1) Then
' Mid(s,2)去除第一个逗号,& vbCrLf为换行
MsgBox (Mid(s, 2) & "行不正确,请检查!!"& vbCrLf & "第一列必须为数字" )
Else
'连接数据库,注意要改成自己的
con.ConnectionString = "Provider=SQLOLEDB;Server=127.0.0.1;Database=ss;Uid=sa;Pwd=123456"
con.Open
'先删除数据库中的数
Sql = "delete from [表名]"
con.Execute Sql
' 逐行插入到数据库中
For i = 2 To endr
strSQL = "INSERT INTO 表名 VALUES ('" & sht.Cells(i, 1) & "', '" & (sht.Cells(i, 2)) & "', '" & sht.Cells(i, 3) & "')"
con.Execute (strSQL)
Next
'关闭数据库链接,释放资源
con.Close
Set con = Nothing
End If
End Sub
- 增量更新
Sub 更新插入()
'定义连接对象
Dim con As ADODB.Connection
Set con = New ADODB.Connection
'定义查询语句
Dim strSQL As String
'定义工作表相关
Dim i As Integer
Dim flag As Integer '表格是否合格标志
Dim s As String ' 不符合要求的行数
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("表格名")
Dim endr As Integer
'找到工作表的最后一行
endr = Cells(Rows.Count, 1).End(xlUp).Row
flag = 0
'先校验表格是否符合要求,不符合要求就不能上传到数据库中,即设置flag为1
For i = 2 To endr
If (IsNumeric(sht.Cells(i, 1)) = False) Then
'拼接不符合条件的行,用于报错提示
s = s & "," & i
flag = 1
End If
Next
If (flag = 1) Then
' Mid(s,2)去除第一个逗号
MsgBox (Mid(s, 2) & "行不正确,请检查!!" & vbCrLf & "第一列必须为数字")
Else
'连接数据库,注意要改成自己的
con.ConnectionString = "Provider=SQLOLEDB;Server=127.0.0.1;Database=ss;Uid=sa;Pwd=123456"
con.Open
For i = 2 To endr
strSQL = "if not exists (select * from 表名 where 字段名1 = '" & sht.Cells(i, 1) & "' and 字段名2='" & sht.Cells(i, 2) & "') INSERT INTO 表名 VALUES ('" & sht.Cells(i, 1) & "', '" & (sht.Cells(i, 2)) & "', '" & sht.Cells(i, 3) & "', '" & sht.Cells(i, 4) & "', '" & sht.Cells(i, 5) & "', '" & sht.Cells(i, 6) & "')"
con.Execute (strSQL)
Next
'关闭数据库链接,释放资源
con.Close
Set con = Nothing
End If
End Sub