數(shù)據(jù)庫備份功能

Private Sub Command備份_Click()

'----------------------------------選擇備份到的位置

Dim folderpath As String

Dim dlgOpen As FileDialog

Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)

With dlgOpen

.AllowMultiSelect = False

? ? ?If .Show = -1 Then

? ? ? ? ?folderpath = .SelectedItems(1)

? ? ?Else

? ? ? ? Exit Sub

? ? ?End If

End With

'----------------------------------備份

Dim dbpathname As String

dbpathname = CurrentProject.FullName

Dim bakname As String

bakname = "bak_" & Format(Now, "yyyymmddhhnnss") & CurrentProject.Name

Dim fs As Object

Dim objfile As Object

Set fs = CreateObject("Scripting.FileSystemObject")

fs.copyfile dbpathname, folderpath & "\" & bakname

MsgBox "備份完成"

End Sub

數(shù)據(jù)排序處理

Function 排序去重(ByVal datatext As String, ByVal splittext As String, ByVal sortype As String, ByVal typetext As String) As String

Dim data_array

data_array = Split(datatext, splittext)

DoCmd.SetWarnings (False)

Dim del_sql As String

del_sql = "Delete From 拆分?jǐn)?shù)據(jù)表"

DoCmd.RunSQL del_sql

Dim add_rs As DAO.Recordset

Set add_rs = CurrentDb.OpenRecordset("拆分?jǐn)?shù)據(jù)表", dbOpenTable)

Dim i

With add_rs

For i = 0 To UBound(data_array)

.AddNew

!數(shù)據(jù)名稱.Value = data_array(i)

.Update

Next i

.Close

End With

Set add_rs = Nothing

'生成處理結(jié)果

Dim data_text As String

Dim search_rs As DAO.Recordset

Dim search_sql As String

If typetext = "排序去重" Then

? ? If sortype = "升序" Then

? ? search_sql = "Select * From 篩選不重復(fù)數(shù)據(jù)查詢" & " order by 數(shù)據(jù)名稱 ASC"

? ? Else

? ? search_sql = "Select * From 篩選不重復(fù)數(shù)據(jù)查詢" & " order by 數(shù)據(jù)名稱 DESC"

? ? End If

End If

If typetext = "排序" Then

? ? If sortype = "升序" Then

? ? search_sql = "Select * From 拆分?jǐn)?shù)據(jù)表" & " order by 數(shù)據(jù)名稱 ASC"

? ? Else

? ? search_sql = "Select * From 拆分?jǐn)?shù)據(jù)表" & " order by 數(shù)據(jù)名稱 DESC"

? ? End If

End If

Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)

Do While search_rs.EOF = False

If data_text <> "" Then

data_text = data_text & splittext & search_rs!數(shù)據(jù)名稱.Value

Else

data_text = search_rs!數(shù)據(jù)名稱.Value

End If

search_rs.MoveNext

Loop

search_rs.Close

Set search_rs = Nothing

排序去重 = data_text

End Function

Private Sub Command降序_Click()

If Me.原數(shù)據(jù) <> "" Then

? ? If Me.分隔符 <> "" Then

? ? ? ? Me.處理結(jié)果 = 排序去重(Me.原數(shù)據(jù), Me.分隔符, "降序", "排序")

? ? Else

? ? MsgBox "分隔符不能為空"

? ? End If

Else

Me.處理結(jié)果 = ""

End If

End Sub

Private Sub Command降序去重_Click()

If Me.原數(shù)據(jù) <> "" Then

? ? If Me.分隔符 <> "" Then

? ? ? ? Me.處理結(jié)果 = 排序去重(Me.原數(shù)據(jù), Me.分隔符, "降序", "排序去重")

? ? Else

? ? MsgBox "分隔符不能為空"

? ? End If

Else

Me.處理結(jié)果 = ""

End If

End Sub

Private Sub Command升序_Click()

If Me.原數(shù)據(jù) <> "" Then

? ? If Me.分隔符 <> "" Then

? ? ? ? Me.處理結(jié)果 = 排序去重(Me.原數(shù)據(jù), Me.分隔符, "升序", "排序")

? ? Else

? ? MsgBox "分隔符不能為空"

? ? End If

Else

Me.處理結(jié)果 = ""

End If

End Sub

Private Sub Command升序去重_Click()

If Me.原數(shù)據(jù) <> "" Then

? ? If Me.分隔符 <> "" Then

? ? ? ? Me.處理結(jié)果 = 排序去重(Me.原數(shù)據(jù), Me.分隔符, "升序", "排序去重")

? ? Else

? ? MsgBox "分隔符不能為空"

? ? End If

Else

Me.處理結(jié)果 = ""

End If

End Sub

隨機(jī)跳轉(zhuǎn)記錄

Dim rs1 As DAO.Recordset? ? '定義記錄集變量

Private Sub Command隨機(jī)_Click()

Dim Record_count As Long

? ? Record_count = rs1.RecordCount

? ? Dim rnd_i As Long

? ? '--------------------------------------------------------

? ? Randomize

? ? rnd_i = Int((Record_count - 1 + 1) * Rnd + 1)

? ? rs1.MoveFirst

? ? rs1.Move (rnd_i - 1)

? ? Me.單詞 = rs1.Fields("單詞").Value

? ? Me.詞義 = rs1.Fields("詞義").Value

End Sub

Private Sub Form_Load()

Set rs1 = CurrentDb.OpenRecordset("英語單詞表", dbOpenTable)

End Sub