vba ado的一些封裝

ado封裝

• DataBase
• DataBaseUtil

DataBase

Option Explicit
Private dataBase As String
Private username As String
Private password As String
Private conn As Connection
Private sql As String
Private serverip As String
Private rs As Recordset
Public Property Let letServerip(ip As String)
    serverip = ip
End Property

Public Property Let letDataBase(strDataBase As String)
    dataBase = strDataBase
End Property
Public Property Let letSql(s As String)
    sql = s
    Debug.Print sql
End Property
Public Property Let letUsername(u As String)
    username = u
End Property
Public Property Let letPassword(p As String)
    password = p
End Property

Public Property Get getConnection()
    Set getConnection = conn
End Property

'擷取Excel資料庫
Public Sub getExcelConnection()
    Set conn = CreateObject("adodb.connection")
    With conn
        .Provider = "Microsoft.ace.OLEDB.12.0"
        .ConnectionString = "Data Source=" & dataBase & ";Extended Properties=Excel 12.0"
        .Open
    End With
End Sub
'擷取Mysql資料庫
Public Sub getMysqlConnection()
    Set conn = CreateObject("adodb.connection")
    With conn
        .ConnectionString = "DRIVER=MySQL ODBC 5.3 Unicode Driver;SERVER=" & serverip & ";Database=" & dataBase & ";Uid=" & username & ";Pwd=" & password
        .Open
    End With
End Sub
'擷取SqlServver資料庫
Public Sub getSqlServerConnection()
    Set conn = CreateObject("adodb.connection")
    With conn
        .ConnectionString = "Provider=SQLOLEDB;Initial Catalog=" & dataBase & ";User ID=" & username & ";Password=" & password & ";Data Source=" & serverip
        'Debug.Print "Provider=SQLOLEDB;Initial Catalog=" & dataBase & ";User ID=" & user & ";Password=" & password & ";Data Source=" & serverip
        .Open
    End With
End Sub
'擷取Access資料庫
Public Sub getAccessConnection()
    Set conn = CreateObject("adodb.connection")
    With conn
        .Provider = "Microsoft.ace.OLEDB.12.0"
        .ConnectionString = "Data Source=" & dataBase
        .Open
    End With
End Sub

           

DataBaseUtil

Option Explicit
'操作資料庫
Private record As Recordset
Private dataBase As New dataBase
Private sql As String
Private conn As Connection
Private Const sqlServerUsername = "sa"
Public Property Let letDataBase(db As dataBase)
    Set dataBase = db
End Property

Public Property Let letSql(s)
    sql = s
End Property

Public Property Get getRecordSet()
     If checkRecordNotIsColse() Then
        Set getRecordSet = record
     End If
End Property

'初始化方法
Private Sub init()
    loadConnection
    loadRecordSet
    destroyDataBase
End Sub




'CursorType遊标類型:
'Const adOpenForwardOnly = 0
'前向遊标，為預設遊标，提供最快的運作性能。用它打開recordset，從對至尾順序取得所有結果。它不支援向後滾動，隻允許在結果間單向移動。
'
'Const adOpenKeyset = 1
'靜态遊标，反映第一次打開遊标時表中資料的狀态，遊标無法查明底層表中的資料行是否更新過、删除過或添加了新的資料。不過與隻能前移的洲标不同，靜态遊标可以在結果間前後滾動。
'
'Const adOpenDynamic = 2
'鍵盤驅動的遊标，可以查詢表中底層資料行的某些變化，但不是全部。它特别是可以準确反映資料是否更新過。但它不能查明其它使用者是否曾删除過資料行（删除掉的資料行在recordset中會留下空洞）。鍵盤驅動的遊标支援在結果間前後滾動。
'
'Const adOpenStatic = 3
'動态遊标，是最豐富的遊标類型。遊标打開時可以查詢其他使用者對表的任何改動，而且支援滾動。


'LockType加鎖類型:
'Const adLockReadOnly = 1
'預設的上鎖類型，隻讀方式上鎖允許多個使用者同時讀取同樣的資料，但不能改變資料。
'
'Const adLockPessimistic = 2
'以悲觀上鎖方式打開資料對象。該方式假定在你編輯記錄時會有其它使用者通路資料。此時一旦你開始編輯記錄，其它使用者就不能通路該資料。
'
'Const adLockOptimistic = 3
'以樂觀上鎖方式打開資料對象。該方式假定在你編輯記錄時不會有其它使用者通路資料。在完成改變之前，其它使用者不能通路該記錄。
'
'Const adLockBatchOptimistic = 4
'執行多行批處理更新時使用這種類型


'Options參數:
'Options參數标明用來打開記錄集的指令字元串的類型?告訴ADO被執行的字元串内容的有關資訊有助于高效地執行該指令字元串?
'
'adCMDTable?被執行的字元串包含一個表的名字?
'adCMDText?被執行的字元串包含一個指令文本?
'adCMDStoredProc?被執行的字元串包含一個存儲過程名?
'adCMDUnknown?不指定字元串的内容? (這是預設值?)


'Recordset.State
'
'AdStateClosed 預設，訓示對象是關閉的。
'adStateOpen 訓示對象是打開的?
'AdStateConnecting 訓示 Recordset 對象正在連接配接。
'AdStateExecuting 訓示 Recordset 對象正在執行指令。
'AdStateFetching 訓示 Recordset 對象的行正在被讀取。
'
'VB中的常數 , 可以參考一下:
'adStateClosed = 0
'adStateOpen = 1
'adStateConnecting = 2
'adStateFetching = 8
'adStateExecuting = 4

'Recordset.Find Criteria, [SkipRows], [SearchDirection], [Strat]

'criteria:強制性Criteria 參數是定義搜尋條件的字元串。該字元串必須包含一個字段（列）名稱，一個比較運算符和一個搜尋值。
'SkipRows;可選的SkipRecords 參數是一個很長的值，它指定在開始搜尋之前要跳過目前記錄之外的多少條記錄。預設值為零，這意味着搜尋從目前記錄開始。

'SearchDirection可以是adSearchForward，表示向前搜尋記錄；或者adSearchBackward，表示向後搜尋記錄。
'SearchDirectionEnum:
'adSearchBackward     -1  從指定的起點向後搜尋到第一條記錄
'adSearchForward   1  從指定的起點搜尋到最後一條記錄

'Start:可選的Start參數是一個變體，可以是書簽，也可以是BookmarkEnum常量之一，它訓示搜尋的開始位置。預設值是從目前記錄開始。。
'BookmarkEnum:
'adBookmarkCurrent 0  預設值，從目前記錄開始搜尋
'adBookmarkFirst 1 從第一條記錄開始搜尋
'adBookmarkLast 2 從最後一條記錄開始搜尋

'如果打開相應的記錄，目前指針将位于比對的記錄上，如果沒有找到記錄，那麼将位于下面兩個位置中的一個：
'· 如果是向前搜尋，則位于記錄集末尾位置的後面，EOF被設定為True。
'· 如果是向後搜尋，則位于記錄集開始位置的前面，BOF被設定為True。
'使用書簽儲存位置
'如果沒有找到相應的記錄，記錄的重新定位可以由書簽輕松解決，因為可以為目前位置制作書簽，如果在查找記錄過程中沒有找到所需的記錄，那麼再移回到上次儲存的位置。

'dim varBookMark as Variant
'varBookMark = rsChantList.Bookmark
'rsChantList.MoveFirst
'rsChantList.Find "ChantName = 'Oma' "
'If (rsChantList.BOF = True) Or (rsChantList.EOF = True) Then
'   MsgBox "Record not found"
'   rsChantList.Bookmark = varBookMark
'End If

'https://blog.csdn.net/Charles_ke/article/details/88714724


'加載記錄集
Private Sub loadRecordSet()
    
    Set record = New Recordset
    record.CursorLocation = adUseClientBatch 'adUseClientBatch
    record.Open sql, conn, CursorType:=adOpenDynamic, LockType:=adLockBatchOptimistic 'adLockBatchOptimistic
End Sub

'檢驗recordSet是否不為空
Function checkRecordNotIsColse()
    checkRecordNotIsColse = record.State <> 0
End Function

'加載連結
Private Sub loadConnection()
    Set conn = dataBase.getConnection
End Sub

'銷毀dataBase
Private Sub destroyDataBase()
    Set dataBase = Nothing
End Sub

'根據IP後3位和密碼擷取Connection
Private Sub getSqlServerDataBase(ipLast, password)
    
End Sub

'擷取Excel為資料庫
Private Sub getExcelDataBase(path)
    With dataBase
        .letDataBase = path
        .getExcelConnection
    End With
End Sub

'擷取mdb檔案
Private Sub getAccessDataBase()
    With dataBase
        .letDataBase = accessPath
        .getAccessConnection
    End With

End Sub

'擷取mysql的dataBase
Private Sub getMysqlDataBase(ipLast, dabaBaseName As String)
    
End Sub

'執行Sql擷取其中資料，并預設放置在[a1]
Sub extractDataInR1C1()
    getFieldName [a1]
    executeDQLSql [a2]
End Sub

'連結sqlServer資料庫，需要傳入sql語句
Sub getDataBaseUtilForSqlServer(strSql, ipLast, password)
    getSqlServerDataBase ipLast, password
    sql = strSql
    init
End Sub


'連結Excel
Sub getDataBaseUtilForExcel(strSql, path)
    getExcelDataBase (path)
    sql = strSql
    init
End Sub

'連結Access
Sub getDataBaseUtilForAccess(strSql)
    getAccessDataBase
    sql = strSql
    init
End Sub

'連結mysql資料庫，需要傳入sql語句 和ip後3位
Sub getDataBaseUtilForMysql(strSql, ipLast, dabaBaseName As String)
    getMysqlDataBase ipLast, dabaBaseName
    sql = strSql
    init
End Sub

'添加新的淘寶asin
Sub saveOrUpdateAsin(sku, asin, site)
    If checkAsinIsExistInRecordset(asin) Then
        updateAsin sku, asin, site
    Else
        addNewAsin
        updateAsin sku, asin, site
    End If
End Sub

'向記錄集中添加sku和asin
Sub addNewAsin()
    record.AddNew
End Sub

Sub updateAsin(sku, asin, site)
     With record
        .Fields("sku") = sku
        .Fields("asin") = asin
        .Fields("site") = site
    End With
    updateRecordSet
End Sub

'檢驗recordSet中是否存在asin
Function checkAsinIsExistInRecordset(asinId)
    record.MoveFirst
    record.Find ("asin=" & asinId)
    If record.EOF Then
        checkAsinIsExistInRecordset = True
    Else
        checkAsinIsExistInRecordset = False
    End If
End Function

'單條更新
Sub updateRecordSet()
    record.update
End Sub

'批量更新到資料庫
Sub updateRecordSetBatch()
    record.UpdateBatch
End Sub

'關閉連結
Public Sub closeConnection()
    If checkRecordNotIsColse() Then
        record.Close
        Set record = Nothing
    End If
    conn.Close
    Set conn = Nothing
End Sub

'抽取查詢資料到指定單元格
Public Sub executeDQLSql(range As range)
    range.CopyFromRecordset record

End Sub

'執行DML語句
Public Sub executeDMLSql()
    conn.Execute (sql)

End Sub

'擷取字段名，并放置到指定單元格
Public Sub getFieldName(rng As range)
    Dim fieldNum%
    Dim fieldsName$
    For fieldNum = 0 To record.Fields.count - 1
        fieldsName = fieldsName & record.Fields.item(fieldNum).name & ","
    Next
    'Debug.Print fieldsName
    rng.Resize(, UBound(Split(fieldsName, ","))) = Application.Transpose(Application.Transpose(Split(fieldsName, ",")))
End Sub

'以sku為主鍵,更新結果
Public Sub updataRecord(sku As Variant, name As String, param As Variant)
    With record
        .Find "ssku=" & sku
        .Fields(name) = .Fields(name).value & "," & param
        .MoveFirst
    End With
End Sub