[分享][Excel VBA]Excel数据库连接

Public Conn                            As ADODB.Connection       '声明ADODB.Connection对象变量
  Public Rdset                          As ADODB.Recordset
Public sCode, sArea, sClerk, sRecorder, sStatus, sCust, sSatis As String
Public dDate, dKD, dPD, dDD, dWC As Date
Public Flg, ConnFlg, ErrConn        As Boolean

Function Open_Conn(SqlDatabaseName, SqlPassword, SqlUsername)

Dim sConnStr As String                 '声明存放连接串的字符串变量
Dim sSQL      As String
Dim TempC     As String


       '打开数据库连接
         Set Conn = New ADODB.Connection
         sConnStr = "Provider=sqloledb;server=ewaysun;Uid=sa;Pwd=;Database=helpdesk"
         Conn.Open sConnStr
         TempC = Repeat_Check(sCode, Conn)

        If Conn Is Nothing Then
           MsgBox "数据连接错误!"
           ErrConn = True
           Exit Function
        Else
           ConnFlg = True
        End If

End Function

'插入数据库记录
Function Open_Recorder(dDate, sCode, sArea, dKD, dPD, dDD, dWC, sClerk, sRecorder, sStatus, sCust, sSatis)

    '添加记录
    Rdset.AddNew
    Rdset!currdate = dDate
    Rdset!Code = sCode
    Rdset!area = sArea
    Rdset!kdtime = dKD
    Rdset!pdtime = dPD
    Rdset!ddtime = dDD
    Rdset!wctime = Date & " " & dWC
    Rdset!clerk = sClerk
    Rdset!Recorder = sRecorder
    Rdset!Status = sStatus
    Rdset!customer = sCust
    Rdset!satis = sSatis

Rdset.Update
End Function

'判断重复插入
Function Repeat_Check(sCode, Conn)
Dim sCheck, TmpO As String

     '打开表
     Set Rdset = New ADODB.Recordset
     Rdset.CursorType = adOpenKeyset
     Rdset.LockType = adLockOptimistic
     Rdset.Open "work", Conn
     Rdset.Close

     sCheck = "select * from work where code=" & sCode
     Rdset.Open sCheck, Conn
     If Rdset.EOF Then
        TmpO = Open_Recorder(dDate, sCode, sArea, dKD, dPD, dDD, dWC, sClerk, sRecorder, sStatus, sCust, sSatis)
     Else
        MsgBox "插入记录重复,请检查输入是否有误!", vbOKOnly + vbCritical, "提醒"
        Flg = True
        Exit Function
     End If
End Function

---------从数据库取数存放到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"