关闭

vba操作数据库

标签: vbafunctionstring数据库sqlserverdatabase
5194人阅读 评论(1) 收藏 举报
分类:
 
以下内容为程序代码:

Sub test()
' 连接Oracle数据库
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open "Provider=MSDAORA.1;Data Source=数据源;User ID=用户名;Password=密码;Persist Security Info=True"
cn.Execute ("执行的数据库更新语句")
' 通过表或者查询创建数据集
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "表名", cn, adOpenKeyset, adLockOptimistic
MsgBox rs.RecordCount
rs.Close
rs.Open "Select 字段 From 表名 Where 条件", cn, adOpenKeyset, adLockOptimistic
MsgBox rs.RecordCount

' 关闭数据集和数据连接
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

ADODB方式连接SqlServer数据库

数据库连接方法:

Public Function conn_sqlServer(ByVal serverIP As String, _
                                     userid As String, _
                                     password As String, _
                                     database As String) As Connection
    Dim sConStr As String
    sConStr = "driver=sql server;" _
              & "server=" & serverIP _
              & ";Uid=" & userid _
              & ";Pwd=" & password _
              & ";Database=" & database
             
    Set conn = New ADODB.Connection
    conn.Open sConStr
   
    If conn Is Nothing Then
        MsgBox "データベースは失敗につながります."
        Exit Function
    Else
        Set conn_sqlServer = conn
    End If
End Function

其中,各参数代表的意义如下:

          serverIP :数据库服务器的IP地址、userid:数据库的用户名、password:数据库的用户密码、database:数据库

的实例名。

关闭数据库连接方法代码如下

Public Function closeConnection(ByVal conn As Connection)
    If conn Is Nothing Then
        MsgBox "データベースの接続は空です"
    Else
        conn.Close
    End If
End Function

其中,参数 conn :要关闭的连接。

执行查询语句的方法代码如下:

Public Function executeQuery(ByVal conn As Connection, querySql As String) As Recordset
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    If conn Is Nothing Then
        MsgBox "データベースの接続は空です"
    Else
        rs.Open querySql, conn, 1, 3
    End If
   
    Set executeQuery = rs
End Function
其中,参数 conn :数据库连接、querySql :查询语句。返回值为查询结果集。

执行非查询语句的方法代码如下:

Public Function excuteUpdateDatabase(ByVal conn As Connection, updateSql As String) As Boolean
   
    Dim excuteResult As Boolean
    excuteResult = False
   
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    conn.BeginTrans
    If conn Is Nothing Then
        MsgBox "データベースの接続は空です"
    Else
         Set rs = conn.Execute(updateSql)
    End If
    If rs Is Nothing Then
        msgbox  "いかなる行に影響していません" 
    Else
        excuteResult = True
        conn.CommitTrans
    End If
   
    excuteUpdateDatabase = excuteResult
End Function

其中,参数 conn :数据库连接、querySql :非查询语句。返回值:成功返回true,否侧返回false。

开启事务方法代码如下

Public Function begin_trans(ByVal conn As Connection)
    If conn Is Nothing Then
        MsgBox "データベースの接続は空です"
    Else
        conn.BeginTrans
    End If
End Function

其中,参数 conn:数据库连接。

提交事务的方法代码如下

Public Function commit_trans(ByVal conn As Connection)
    If conn Is Nothing Then
        MsgBox "データベースの接続は空です"
    Else
        conn.CommitTrans
    End If
End Function

其中,参数 conn:数据库连接。

回滚事务的方法代码如下

Public Function roolback_trans(ByVal conn As Connection)
    If conn Is Nothing Then
        MsgBox "データベースの接続は空です"
    Else
        conn.RollbackTrans
    End If
End Function

其中,参数 conn:数据库连接。

调用存储过程代码如下

Public Function callPr_restore(ByVal conn As Connection, pr_restore_name As String)
    Dim CNN_cmd As ADODB.Command
    Set CNN_cmd = New ADODB.Command
    Set CNN_cmd.ActiveConnection = conn               
    
    CNN_cmd.CommandText = pr_restore_name
    CNN_cmd.CommandType = adCmdStoredProc

'------------------------有参存储过程加以下代码----------------------------------

    With CNN_cmd

        ' 两种方式给参数赋值

        ' 第一种:CNN_cmd.P阿rameters(参数索引).value = 参数值

         ' 第二种:.CNN_cmd.Parameters.Append .CreateParameter(参数名,adVarChar, adParamInput, 10,

          参数值)

        .Parameters(1).Value = "20030611"
        .Parameters.Append .CreateParameter("stunum", adVarChar, adParamInput, 10, "20030610")
        .Parameters.Append .CreateParameter("sPrefix", adVarChar, adParamInput, 4, "2004")
        .Parameters.Append .CreateParameter("iLength", adInteger, adParamInput, , 5)
        .Parameters.Append .CreateParameter("sSequenceNumber", adVarChar, adParamOutput, 7,    

         sSequenceNumber)
    End With

'---------------------------------------END--------------------------------------------
    CNN_cmd.Execute 
End Function

其中,参数conn:数据库连接、pr_restore_name:存储过程名。

---------从数据库取数存放到excel表格------

Function Open_Conn(SqlDatabaseName, SqlPassword, SqlUsername)
  
  Dim Conn       As ADODB.Connection       '声明ADODB.Connection对象变量
  Dim Rdset      As ADODB.Recordset
  Dim TempC      As String
  Dim sSQL       As String
  Dim Rng        As String
  Dim I          As Integer

    sSQL = "select  Code,Area, KDtime, PDtime, DDtime, WCtime, Clerk, Status from work "
   
    '打开数据库连接
      Set Conn = New ADODB.Connection
      sConnStr = "Provider=sqloledb;server=ewaysun;Uid=sa;Pwd=;Database=helpdesk"
      Conn.Open sConnStr
      Rng = [a65535].End(xlUp).Row                                       '判断有记录的最后一行
      If Rng <> 1 Then                                                   '判断清空的起始行
             Range(Cells(2, 1), Cells(Rng, 8)).ClearContents                     '清空数据
             Cells(2, 1).CopyFromRecordset Conn.Execute(sSQL)            '查询后插入单元格
             Columns("C:E").Select
             Selection.NumberFormatLocal = "yyyy-mm-dd hh:mm"
             Columns("F:F").Select
             Selection.NumberFormatLocal = "[$-F400]hh:mm:ss AM/PM"
             Rng = [a65535].End(xlUp).Row
             Range(Cells(2, 1), Cells(Rng, 8)).Select
             '按人名排序
              Selection.Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
                    :=xlPinYin, DataOption1:=xlSortNormal
              Range(Cells(2, 1), Cells(Rng, 8)).Select
             '设置表格底纹
             Selection.Borders(xlDiagonalDown).LineStyle = xlNone
             Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With Selection.Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            
            '位置居中
          With Selection
              .HorizontalAlignment = xlCenter
              .VerticalAlignment = xlCenter
              .WrapText = False
              .Orientation = 0
              .AddIndent = False
              .IndentLevel = 0
              .ShrinkToFit = False
              .ReadingOrder = xlContext
              .MergeCells = False
          End With
      Else
             Cells(2, 1).CopyFromRecordset Conn.Execute(sSQL)            '查询后插入单元格
             Rng = [a65535].End(xlUp).Row                                       '判断有记录的最后一行
             Range(Cells(2, 1), Cells(Rng, 8)).Select
             '按人名排序
              Selection.Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlGuess, _
                  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
                    :=xlPinYin, DataOption1:=xlSortNormal
            
             Columns("C:E").Select
             Selection.NumberFormatLocal = "yyyy-mm-dd hh:mm"
             Columns("F:F").Select
             Selection.NumberFormatLocal = "[$-F400]hh:mm:ss AM/PM"

     End If
      Cells(2, 1).Select
     
      If Conn Is Nothing Then
         MsgBox "数据连接错误!"
      End If
End Function

----------------------------------------------------通过querytable属性向excel中导入数据--------------------------------------------

向Excel中导入数据的函数
Public Function fillData(ByVal rs As ADODB.Recordset, _
                            sheetIndex As Integer, _
                            beginCell As String, _
                            EdgeLine As String, _
                            InsideLine As String)
                           
    With Sheets(sheetIndex).QueryTables.Add(rs, Sheets(sheetIndex).Range(beginCell))
        .FieldNames = False
        .Refresh
    End With
   
    Call setBorders(sheetIndex, beginCell, EdgeLine, InsideLine)
   
End Function

其中,rs为结果集、sheetIndex为sheet的索引、beginCell为开始添加数据的cell、EdgeLine为数据区域的外部边框线宽、InsideLine为数据区域的内部边框线宽。


设置数据区域边框的函数
Private Function setBorders(ByVal sheetIndex As Integer, _
                                  beginCell As String, _
                                  EdgeLine As String, _
                                  InsideLine As String)
                                 
    Sheets(sheetIndex).Range(beginCell).CurrentRegion.Select
   
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = EdgeLine
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = EdgeLine
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = EdgeLine
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = EdgeLine
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = InsideLine
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = InsideLine
        .ColorIndex = xlAutomatic
    End With
   
End Function

其中,sheetIndex为sheet的索引、beginCell为开始添加数据的cell、EdgeLine为数据区域的外部边框线宽、InsideLine为数据区域的内部边框线宽。

QeryTable的属性列表如下:

With QueryTable.FieldNames = True
         
     .RowNumbers = False
        
      .FillAdjacentFormulas = False
       
     .PreserveFormatting = True
       
      .RefreshOnFileOpen = False
       
      .BackgroundQuery = True
       
     .RefreshStyle = xlInsertDeleteCells
       
      .SavePassword = True
       
      .SaveData = True
       
     .AdjustColumnWidth = True
       
     .RefreshPeriod = 0
       
     .PreserveColumnInfo = True
    End With

0
0

查看评论
* 以上用户言论只代表其个人观点,不代表CSDN网站的观点或立场
    个人资料
    • 访问:36381次
    • 积分:511
    • 等级:
    • 排名:千里之外
    • 原创:14篇
    • 转载:9篇
    • 译文:0篇
    • 评论:2条
    文章分类
    最新评论