vba连接数据库，插入数据

VBA

以前不根本没有接触过，写来试试，看了几篇基础的VBA语法，开始上手写吧

需求

1. 将表格里的数据导入更新到sql server数据库中去（全删全插）；
2. 将表格里的数据导入更新到sql server数据库中去（增量更新）。

实现过程

1. 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

2. 可以检查表格信息是否正确

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

总代码

1. 全删全插

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

1. 增量更新

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