列表框查詢窗體

Dim cj_filter As String

Private Sub Command查詢_Click()

On Error GoTo 結束查詢

If Me.查詢字段 = "考試日期" Then

? ? If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then

? ? ? ? cj_filter = "Select * from 學生成績表 Where " & Me.查詢字段 & " between #" & Me.起始日期 & "# and #" & Me.截止日期 & "#"

? ? ? ? Me.列表框1.RowSource = cj_filter

? ? Else

? ? ? ? cj_filter = "Select * From 學生成績表"

? ? Me.列表框1.RowSource = cj_filter

? ? End If

? ? Exit Sub

End If

If Me.查詢字段 = "分數" Then

? ? If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then

? ? ? ? cj_filter = "Select * from 學生成績表 Where " & Me.查詢字段 & " >= " & Me.最小 & " And " & Me.查詢字段 & " <= " & Me.最大

? ? ? ? Me.列表框1.RowSource = cj_filter

? ? Else

? ? ? ? cj_filter = "Select * From 學生成績表"

? ? ? ? Me.列表框1.RowSource = cj_filter

? ? End If

? ? Exit Sub

End If

If 查詢內容 <> "" And IsNull(查詢內容) = False And 查詢字段 <> "" And IsNull(查詢字段) = False Then

? ? cj_filter = "Select * From 學生成績表 Where " & Me.查詢字段 & " like '*" & Me.查詢內容 & "*'"

? ? Me.列表框1.RowSource = cj_filter

Else

? ? cj_filter = "Select * From 學生成績表"

? ? Me.列表框1.RowSource = cj_filter

End If

? ? Exit Sub

結束查詢:

? ? MsgBox Err.Description

End Sub

Private Sub Command全部_Click()

cj_filter = "Select * From 學生成績表"

Me.列表框1.RowSource = cj_filter

End Sub

Private Sub Form_Load()

Me.起始日期.Visible = False

Me.截止日期.Visible = False

Me.最小.Visible = False

Me.最大.Visible = False

Me.查詢內容.Visible = True

End Sub

Private Sub 查詢字段_Change()

If Me.查詢字段 = "考試日期" Then

Me.起始日期.Visible = True

Me.截止日期.Visible = True

Me.最小.Visible = False

Me.最大.Visible = False

Me.查詢內容.Visible = False

Exit Sub

Else

Me.起始日期.Visible = False

Me.截止日期.Visible = False

Me.最小.Visible = False

Me.最大.Visible = False

Me.查詢內容.Visible = True

End If

If Me.查詢字段 = "分數" Then

Me.起始日期.Visible = False

Me.截止日期.Visible = False

Me.最小.Visible = True

Me.最大.Visible = True

Me.查詢內容.Visible = False

Exit Sub

Else

Me.起始日期.Visible = False

Me.截止日期.Visible = False

Me.最小.Visible = False

Me.最大.Visible = False

Me.查詢內容.Visible = True

End If

End Sub

列表框聯(lián)動

Private Sub 列表框1_DblClick(Cancel As Integer)

If IsNull(列表框1.Value) = False Then

? ? Me.列表框2.RowSource = "SELECT ID, 二級項目 FROM 二級表 WHERE 一級項目='" & 列表框1.Value & "'"

? ? Me.列表框3.RowSource = ""

End If

End Sub

Private Sub 列表框2_DblClick(Cancel As Integer)

If IsNull(列表框2.Value) = False Then

? ? Me.列表框3.RowSource = "SELECT 三級項目 FROM 三級表 WHERE 二級ID=" & Me.列表框2.Value

End If

End Sub

批量導入導出附件中的文件

Private Sub Command導出_Click()? ? ?'導出

'選擇導出的位置（文件夾）

Dim exportpath As String

Dim dlgOpen As FileDialog

Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)

With dlgOpen

? ? ?If .Show = -1 Then

? ? ? ? exportpath = .SelectedItems(1)

? ? ? ? Else

? ? ? ? Exit Sub

? ? ?End If

End With

Dim filers As Recordset

Dim filerecord As Recordset

Set filerecord = CurrentDb.OpenRecordset("文件記錄表", dbOpenTable)

Do While filerecord.EOF = False

If filerecord.Fields("選擇").Value = True Then

? ? Set filers = filerecord.Fields("文件附件").Value

? ? Do While filers.EOF = False

? ? ? ? filers.Fields("FileData").SaveToFile exportpath

? ? ? ? filers.MoveNext

? ? Loop

End If

filerecord.MoveNext

Loop

MsgBox "導出完成"

End Sub

Private Sub Command添加_Click()? ? ?'添加

On Error Resume Next

Dim vrtSelectedItem

Dim newid As Long

Dim filers As Recordset

Dim filerecord As Recordset

With Application.FileDialog(msoFileDialogFilePicker)

? ? ? ? .AllowMultiSelect = True

? ? ? ? If .Show = -1 Then

? ? ? ? Set filerecord = CurrentDb.OpenRecordset("文件記錄表", dbOpenTable)

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

? ? ? ? ? ? '獲取文件名和路徑

? ? ? ? ? ? DoCmd.SetWarnings (False)

? ? ? ? ? ? Dim add_sql As String

? ? ? ? ? ? add_sql = "Insert Into 文件記錄表 (文件名稱) Values ('" & 處理文件名(vrtSelectedItem) & "')"

? ? ? ? ? ? DoCmd.RunSQL add_sql

? ? ? ? ? ? '獲取最新ID

? ? ? ? ? ? newid = Nz(DMax("ID", "文件記錄表"), 0)

? ? ? ? ? ? If newid <> 0 Then '上傳附件

? ? ? ? ? ? filerecord.MoveLast

? ? ? ? ? ? filerecord.Edit

? ? ? ? ? ? Set filers = filerecord.Fields("文件附件").Value

? ? ? ? ? ? filers.AddNew

? ? ? ? ? ? filers.Fields("Filedata").LoadFromFile vrtSelectedItem

? ? ? ? ? ? filers.Update

? ? ? ? ? ? filers.Close

? ? ? ? ? ? filerecord.Update

? ? ? ? ? ? End If

? ? ? ? ? ? Next vrtSelectedItem

? ? ? ? Else

? ? ? ? Exit Sub

? ? ? ? End If

End With

Me.數據表子窗體.Requery

End Sub

Function 處理文件名(ByVal filepathname As String) As String

On Error Resume Next

處理文件名 = ""

Dim a1 As Long

a1 = InStrRev(filepathname, "\")

處理文件名 = Right(filepathname, Len(filepathname) - a1)

End Function