批量導入數(shù)據(jù)

Private Sub Command清空_Click()

DoCmd.SetWarnings (False)

Dim del_sql As String

del_sql = "Delete From 導入考試成績表"

DoCmd.RunSQL del_sql

Me.數(shù)據(jù)表子窗體.Requery

End Sub

Private Sub Command添加_Click()

If MsgBox("是否上傳數(shù)據(jù)至考試成績表", vbOKCancel) = vbOK Then

DoCmd.SetWarnings (False)

Dim copy_sql As String

copy_sql = "Insert into 考試成績表 Select * From 導入考試成績表"

DoCmd.RunSQL copy_sql

MsgBox "導入完成"

Me.數(shù)據(jù)表子窗體2.Requery

End If

End Sub

批量更新數(shù)據(jù)

Private Sub Command更新1_Click()? ? '前端添加

If 修改字段 = "" Or IsNull(修改字段) = True Then

MsgBox "修改字段值為空！"

Exit Sub

End If

Dim search_rs As DAO.Recordset

Dim search_sql As String

search_sql = "Select * From 學生信息表"

Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)

Do While search_rs.EOF = False

search_rs.Edit

search_rs.Fields(Me.修改字段).Value = Me.前端添加 & search_rs.Fields(Me.修改字段).Value

search_rs.Update

search_rs.MoveNext

Loop

search_rs.Close

Set search_rs = Nothing

MsgBox "處理完成"

End Sub

Private Sub Command更新2_Click()? ? '后端添加

If 修改字段 = "" Or IsNull(修改字段) = True Then

MsgBox "修改字段值為空！"

Exit Sub

End If

Dim search_rs As DAO.Recordset

Dim search_sql As String

search_sql = "Select * From 學生信息表"

Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)

Do While search_rs.EOF = False

search_rs.Edit

search_rs.Fields(Me.修改字段).Value = search_rs.Fields(Me.修改字段).Value & Me.后端添加

search_rs.Update

search_rs.MoveNext

Loop

search_rs.Close

Set search_rs = Nothing

MsgBox "處理完成"

End Sub

Private Sub Command更新3_Click()? ? '全部替換

If 修改字段 = "" Or IsNull(修改字段) = True Then

MsgBox "修改字段值為空！"

Exit Sub

End If

Dim search_rs As DAO.Recordset

Dim search_sql As String

search_sql = "Select * From 學生信息表"

Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)

Do While search_rs.EOF = False

search_rs.Edit

search_rs.Fields(Me.修改字段).Value = Me.全部替換

search_rs.Update

search_rs.MoveNext

Loop

search_rs.Close

Set search_rs = Nothing

MsgBox "處理完成"

End Sub

Private Sub Command更新4_Click()? ? '查找替換

If 修改字段 = "" Or IsNull(修改字段) = True Then

MsgBox "修改字段值為空！"

Exit Sub

End If

Dim search_rs As DAO.Recordset

Dim search_sql As String

search_sql = "Select * From 學生信息表"

Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)

Dim a1 As String

Do While search_rs.EOF = False

search_rs.Edit

a1 = search_rs.Fields(Me.修改字段).Value

search_rs.Fields(Me.修改字段).Value = Replace(a1, Me.查找值, Me.替換值)

search_rs.Update

search_rs.MoveNext

Loop

search_rs.Close

Set search_rs = Nothing

MsgBox "處理完成"

End Sub

批量獲取文件目錄

Dim add_rs As DAO.Recordset

Private Sub Command獲取_Click()

Set add_rs = CurrentDb.OpenRecordset("文件目錄表", dbOpenTable)

Dim vrtSelectedItem

Dim fpath

Dim fs_folder As Object

Dim fs As Object

If MsgBox("是否包含子文件夾中的文件？選擇是則包含，否則不包含", vbYesNo) = vbYes Then

? ? '---包含子文件夾

? ? With Application.FileDialog(msoFileDialogFolderPicker)

? ? ? ? ? ? .AllowMultiSelect = False

? ? ? ? ? ? If .Show = -1 Then

? ? ? ? ? ? ? ? ?Set fs = CreateObject("Scripting.FileSystemObject")

? ? ? ? ? ? ? ? For Each vrtSelectedItem In .SelectedItems

? ? ? ? ? ? ? ? ? ? fpath = vrtSelectedItem

? ? ? ? ? ? ? ? ? ? If IsNull(fpath) Or fpath = "" Then

? ? ? ? ? ? ? ? ? ? Exit Sub

? ? ? ? ? ? ? ? ? ? End If

? ? ? ? ? ? ? ? ? ? Set fs_folder = fs.GetFolder(fpath)

? ? ? ? ? ? ? ? ? ? Call getfilename(fs_folder)

? ? ? ? ? ? ? ? Next vrtSelectedItem

? ? ? ? ? ? End If

? ? End With

Else

? ? '---不包含文件夾

? ? With Application.FileDialog(msoFileDialogFolderPicker)

? ? ? ? ? ? .AllowMultiSelect = False

? ? ? ? ? ? If .Show = -1 Then

? ? ? ? ? ? ? ? ?Set fs = CreateObject("Scripting.FileSystemObject")

? ? ? ? ? ? ? ? For Each vrtSelectedItem In .SelectedItems

? ? ? ? ? ? ? ? ? ? fpath = vrtSelectedItem

? ? ? ? ? ? ? ? ? ? If IsNull(fpath) Or fpath = "" Then

? ? ? ? ? ? ? ? ? ? Exit Sub

? ? ? ? ? ? ? ? ? ? End If

? ? ? ? ? ? ? ? ? ? Set fs_folder = fs.GetFolder(fpath)

? ? ? ? ? ? ? ? ? ? Call getfilename2(fs_folder)

? ? ? ? ? ? ? ? Next vrtSelectedItem

? ? ? ? ? ? End If

? ? End With

End If

add_rs.Close

Set add_rs = Nothing

Me.數(shù)據(jù)庫子窗體.Requery

End Sub

Sub getfilename(fso)

? ? Dim 文件類型text As String

? ? Dim f

? ? For Each f In fso.Files

? ? ? ? add_rs.AddNew

? ? ? ? add_rs!文件鏈接.Value = f.Path

? ? ? ? 文件類型text = Right(f.Name, Len(f.Name) - InStrRev(f.Name, "."))

? ? ? ? add_rs!文件類型 = 文件類型text

? ? ? ? add_rs!文件名 = Left(f.Name, Len(f.Name) - Len(文件類型text) - 1)

? ? ? ? add_rs!所在文件夾.Value = Left(f.Path, Len(f.Path) - Len(f.Name) - 1)

? ? ? ? add_rs.Update

? ? Next

? ? Dim fo2

? ? For Each fo2 In fso.SubFolders

? ? ? ? Call getfilename(fo2)

? ? Next

End Sub

Sub getfilename2(fso)

Dim 文件類型text As String

? ? Dim f

? ? For Each f In fso.Files

? ? ? ? add_rs.AddNew

? ? ? ? add_rs!文件鏈接.Value = f.Path

? ? ? ? 文件類型text = Right(f.Name, Len(f.Name) - InStrRev(f.Name, "."))

? ? ? ? add_rs!文件類型 = 文件類型text

? ? ? ? add_rs!文件名 = Left(f.Name, Len(f.Name) - Len(文件類型text) - 1)

? ? ? ? add_rs!所在文件夾.Value = Left(f.Path, Len(f.Path) - Len(f.Name) - 1)

? ? ? ? add_rs.Update

? ? Next

End Sub

Private Sub Command清空_Click()

If MsgBox("是否清空目錄表", vbOKCancel) = vbOK Then

DoCmd.SetWarnings (False)

Dim del_sql As String

del_sql = "Delete From 文件目錄表"

DoCmd.RunSQL del_sql

Me.數(shù)據(jù)庫子窗體.Requery

End If

End Sub