vba操作数据库

转载 2007年09月21日 14:48:00
 
以下内容为程序代码:

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

VBA连接Oracle数据库的两种连接字符串的区别:MSDAORA-对象关闭时不允许操作

VBA连接数据库有两种连接字符串: dataSource = Chr(34) & "(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=(PROTOCOL=TCP)(HO...

VBA操作数据库2

'Excel的VBA连接数据库方法 Public Sub GetData()      Dim strConn As String, strSQL As String      Dim conn As...

excel VBA中的数据库基本操作

首先提一下 ,我们学习SQL+ADO访问数据库有什么用处?    '1 可以在不打开EXCEL文件的情况下,从文件中提取数据.    '2 可以从建立连接的专业软件数据库中提取数据.如财务软件等....

VBA操作数据库实例

  • 2017年03月12日 09:15
  • 26KB
  • 下载

VBA操作文件四大方法之三--FileSystemObject

VBA操作文件四大方法之三FileSystemObject    (一)准备工作 (二)FileSystemObject对象的方法 1、GetDrive 方法 2、GetDriveNa...

VBA编程“由于另一个程序正在运行中,此操作无法完成.”解决方法.

这是自动化服务超时引起,它有一个默认的响应时间,解决方法: 在App::InitInstance()里AfxOleInit()之后加上这个: AfxOleGetMessageFilter()->E...
  • HiRuyue
  • HiRuyue
  • 2013年05月07日 20:25
  • 1327

关于VBA对数据透视表的操作使用

http://club.excelhome.net/thread-1147804-1-1.html 小弟不才,初来乍到EH论坛...在学习VBA学习E表的过程中,对于数据透视表的操作,这...
  • nodeman
  • nodeman
  • 2015年08月25日 17:05
  • 846

Excel——如何使用VBA操作单元格的格式

单元格的填充Cell Fills (Color, Patterns, & Gradients) Sub Modify_Cell_Fill()     'Change Fill Color       ...

VBA EXCEL 对象操作 - 新建工作表

From  http://club.excelhome.net/forum.php?mod=viewthread&tid=470603&page=23#pid3118642 新建一个工作...
  • navy2009
  • navy2009
  • 2012年02月28日 10:27
  • 11627

EXCEL 操作汇总&&VBA

点击含有超链接的单元格后,在另一单元格显示当前时间 Private Sub Worksheet_SelectionChange(ByVal Target As Range)     If Target...
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:vba操作数据库
举报原因:
原因补充:

(最多只允许输入30个字)