VBA直接操作数据库

最新推荐文章于 2023-10-21 00:21:18 发布

CherishZheng

最新推荐文章于 2023-10-21 00:21:18 发布

阅读量913

点赞数 2

本文链接：https://blog.csdn.net/zheng525zheng/article/details/8469235

版权

想要整一个客户端式的查询数据库工具，并且将数据录入到Excel中，整理一下需要的语句

Sub BUtton2_Click()
    
    Set wsConfig = Worksheets("数据控制")
    orderCommand = wsConfig.Cells(3, 3)
    tempStr = LCase(orderCommand)
    If InStr(tempStr, "select") = 1 And checkSQL(tempStr) Then
        If MsgBox("确认需要进行数据导出？", vbOKCancel, "提示") = vbOK Then
            DATABASEIP = "****"
            DATABASEPORT = ****

            DATABASEUSERBAME = ***

            DATABASEPSD = "****"
            DATABASENAME = "rtc_prod"
            sConn = "Provider=IBMDADB2;Database=" & DATABASENAME & ";Hostname=" & DATABASEIP & ";Protocol=TCPIP; Port=" & DATABASEPORT & ";Uid= " & DATABASEUSERBAME & ";Pwd=" & DATABASEPSD & ";"
            Set oConn = CreateObject("ADODB.Connection")
            oConn.Open sConn
            If (Err.Number <> 0) Then
                MsgBox "程序系统参数有错,程序退出！"
                Exit Sub
            Else
              excuteSQL sConn, orderCommand
            End If
              oConn.Close
        End If
    Else
    MsgBox "数据查询格式不正确！"
    End If
    Set wsConfig = Nothing
End Sub
Function excuteSQL(Conn, sql)
     Set Recordset = CreateObject("ADODB.recordSet")
     Set wsData = Worksheets("数据信息")
     wsData.Cells.Clear
     Recordset.Open sql, Conn, 3
     wsData.Cells(2, 1).CopyFromRecordset Recordset
     For i = 1 To Recordset.Fields.count
        wsData.Cells(1, i) = Recordset.Fields(i - 1).Name
     Next
        '尼玛网上各种骗子欺骗我MSDN有问题是吧。注意这边的recordCount需要在open的时候加行参数
        '0 只读，   数据只能向下移动
        '1 可读写，数据可以自由移动，多用户下别人不能看到新增数据（除非重启动）
        '2 可读写，数据可以自由移动，多用户下别人可以看到新增数据
        '3 只读 ， 数据可以自由移动
        
        '参数2表示锁定类型，如下：
        '参数2           意    义
        '1 默认值，   只读
        '2                    悲观锁定
        '3                    乐观锁定
        '4                   批次乐观锁定


     MsgBox "数据导入成功,员工导出 " & Recordset.RecordCount & " 条记录"
     Recordset.Close
     Set Recordset = Nothing
End Function

Function checkSQL(tempStr)
resultValue = InStr(tempStr, "insert ") <= 0 And InStr(tempStr, "update ") <= 0 And InStr(tempStr, "delete ") <= 0
checkSQL = resultValue
End Function

还有一个其他的，从Excel读取之后操作数据库的，附上源码

Function getDataFromExcel(Conn)
    Dim wsConfig As Excel.Worksheet, wsData As Excel.Worksheet
    Dim employeeCode, employeeName, ORGANIZATIONCODE, ORGANIZATIONNAME, DEPARTMENTCODE, DEPARTMENTNAME, price, supType, bizModule, bizArea  
    Set wsData = Worksheets("数据信息") 
    Dim RowCounts, RowIndex, FirstRowIndex
    FirstRowIndex = 2
    RowCounts = 2
    RowIndex = FirstRowIndex
    Set curCell = wsData.Cells(RowIndex, 1)   
    '计算总行数
    Do While Not IsEmpty(curCell)
        RowIndex = RowIndex + 1
        Set curCell = wsData.Cells(RowIndex, 1)
    Loop
    RowCounts = RowIndex - 2
    For i = 2 To RowCounts + 1
        XX = Trim(wsData.Cells(i, 1))
        XX = Trim(wsData.Cells(i, 2))
        XX = Trim(wsData.Cells(i, 3))
        XX = Trim(wsData.Cells(i, 4))
        XX = Trim(wsData.Cells(i, 5))
        XX = Trim(wsData.Cells(i, 6))
        XX = Trim(wsData.Cells(i, 7))
        XX = Trim(wsData.Cells(i, 8))
        XX = Trim(wsData.Cells(i, 9))
        XX = Trim(wsData.Cells(i, 10))
        XX = isExsitEmpInfo(Conn, employeeCode)
        If XX > 0 Then
           updateEmpInfo Conn,XXXXX
        Else
            insetEmpInfo XXXXX
        End If
    Next
End Function


Function updateEmpInfo(Conn,XXXX)
    Set objCommand = CreateObject("ADODB.COMMAND")
    sql = XXXXXXX
    objCommand.CommandText = sql
     objCommand.ActiveConnection = Conn
    objCommand.Execute
    WriteLog sql
    Set objCommand = Nothing
End Function