批量导入数据

Private Sub Command清空_Click()

DoCmd.SetWarnings (False)

Dim del_sql As String

del_sql = "Delete From 导入考试成绩表"

DoCmd.RunSQL del_sql

Me.数据表子窗体.Requery

End Sub

Private Sub Command添加_Click()

If MsgBox("是否上传数据至考试成绩表", vbOKCancel) = vbOK Then

DoCmd.SetWarnings (False)

Dim copy_sql As String

copy_sql = "Insert into 考试成绩表 Select * From 导入考试成绩表"

DoCmd.RunSQL copy_sql

MsgBox "导入完成"

Me.数据表子窗体2.Requery

End If

End Sub

批量更新数据

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.数据库子窗体.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.数据库子窗体.Requery

End If

End Sub