📄 form_query.frm
字号:
Set itmX = form_WenJian.ListView2.ListItems.Add(, , i)
itmX.SubItems(1) = rs.Fields(0).Value
itmX.SubItems(2) = xml("archive_year") + CStr(xml("RETENTION_PERIOD") + 1) + xml("REFERENCE_CODE_OF_FILE_OFFICE")
itmX.SubItems(3) = xml("archive_year")
Select Case xml("RETENTION_PERIOD")
Case 0
itmX.SubItems(4) = "永久"
Case 1
itmX.SubItems(4) = "长期"
Case 2
itmX.SubItems(4) = "短期"
End Select
itmX.SubItems(5) = xml("REFERENCE_CODE_OF_FILE_OFFICE")
itmX.SubItems(6) = xml("office_code")
itmX.SubItems(7) = xml("office_reference_code")
itmX.SubItems(8) = xml("PRIMARY_CREATOR")
itmX.SubItems(9) = xml("TITLE_PROPER")
itmX.SubItems(10) = xml("DOCUMENT_CODE")
itmX.SubItems(11) = Replace(xml("DATE_BEGUN"), "-", " ") + " " + Replace(xml("DATE_FINISHED"), "-", " ")
itmX.SubItems(12) = xml("medium_quantity")
itmX.SubItems(13) = xml("inboxcode")
itmX.SubItems(14) = xml("boxcode")
itmX.SubItems(15) = xml("NOTES_OF_ARCHIVIST")
Select Case xml("locked")
Case 0
itmX.SubItems(16) = "否"
Case 1
itmX.SubItems(16) = "是"
End Select
rs.MoveNext
Wend
rs.Close
GoTo e:
End If
'=======================================================================
'文件集查询完毕
Dim tCommon As String '取到表名
Select Case form_AnJuan.List1.ListIndex
Case 0
'MsgBox "文书档案" '0
Label7.Visible = True
Text4.Visible = True
tCommon = "T_ARCHIVE_0100_FILE"
Case 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25
'MsgBox "专业档案" '1
tCommon = "T_ARCHIVE_0200_FILE"
Case 10
'会计档案
tCommon = "T_ARCHIVE_0203_file"
'Case 11
'实物档案
'tCommon = "T_ARCHIVE_0204_file"
Case 12
'人物档案
tCommon = "T_ARCHIVE_0500_file"
'Case 13
'电子档案
'tCommon = "T_ARCHIVE_0400_file"
Case 7
'MsgBox "---照片档案" '2
tCommon = "T_ARCHIVE_0202_FILE"
Case 8, 9
'MsgBox "---音、视频档案" '3
tCommon = "T_ARCHIVE_0201_FILE"
Case 2, 3, 4, 5
'MsgBox "科技档案" '19
tCommon = "T_ARCHIVE_0300_FILE"
Case Else
MsgBox "该类档案无查询", vbInformation, ""
Exit Sub
End Select
strSql = "select * from " + tCommon + " where 1=1 "
If Text1.text <> "" Then
strSql = strSql + " and TITLE_PROPER like '%" & Text1.text & "%'"
End If
If Text2.text <> "" Then
strSql = strSql + " and (PRIMARY_CREATOR like '%" & Text2.text & "%' or SUBORDINATE_CREATOR like '%" & Text2.text & "%')"
End If
If Text3.text <> "" Then
strSql = strSql + " and DISCRIPTOR like '%" & Text3.text & "%'"
End If
If Text5.text <> "" Then
strSql = strSql + " and REFERENCE_CODE_OF_FILE_OFFICE like '%" & Text5.text & "%'"
End If
If flagDate = "1" Then
strSql = strSql + " and (date_begun between '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd") & "')"
End If
'文号
Select Case form_AnJuan.List1.ListIndex
Case 0
'MsgBox "文书档案" '0
If Text4.text <> "" Then
strSql = strSql + " and document_code like '%" & Text4.text & "%'"
End If
strSql = strSql + " and not(file_number=0) "
Case 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25
'MsgBox "专业档案" '1
strSql = strSql + " and class_code='" & form_AnJuan.List1.ListIndex & "'"
Case 10, 11, 12, 13
Case 7
'MsgBox "---照片档案" '2
If Text4.text <> "" Then
strSql = strSql + " and take_photo_person like '%" & Text4.text & "%'"
End If
strSql = strSql + " and class_code='" & form_AnJuan.List1.ListIndex & "'"
Case 8, 9
'MsgBox "---音、视频档案" '3
If Text4.text <> "" Then
strSql = strSql + " and take_video_person like '%" & Text4.text & "%'"
End If
strSql = strSql + " and class_code='" & form_AnJuan.List1.ListIndex & "'"
Case 2, 3, 4, 5
'MsgBox "科技档案" '19
strSql = strSql + " and class_code='" & form_AnJuan.List1.ListIndex & "'"
Case Else
MsgBox "请选择小类档案", vbInformation, ""
Exit Sub
End Select
Select Case form_AnJuan.List1.ListIndex
Case 0
strSql = strSql + " order by REFERENCE_CODE_OF_FILE_OFFICE,number_of_page"
Case Else
strSql = strSql + " order by REFERENCE_CODE_OF_FILE_OFFICE"
End Select
flagWhereF = strSql
'MsgBox strSql
form_AnJuan.ListView2.ListItems.Clear
'=====================================
Select Case form_AnJuan.List1.ListIndex
Case 7
strSql = strSql + ",STARTING_PHOTO_CODE "
End Select
'=====================================
rs.Open strSql, conn
While Not rs.EOF
i = i + 1
Select Case form_AnJuan.List1.ListIndex
Case 0
Set itmX = form_AnJuan.ListView2.ListItems.Add(, , xml("number_of_page"))
itmX.SubItems(1) = rs.Fields(0).Value
itmX.SubItems(2) = xml("REFERENCE_CODE_OF_FILE_OFFICE")
itmX.SubItems(3) = xml("document_code")
If (rs!TITLE_PROPER <> "") Then
itmX.SubItems(4) = rs!TITLE_PROPER
End If
If (rs!PRIMARY_CREATOR <> "") Then
itmX.SubItems(5) = rs!PRIMARY_CREATOR
End If
If (rs!DATE_BEGUN <> "") Then
itmX.SubItems(6) = rs!DATE_BEGUN
End If
Select Case xml("RETENTION_PERIOD")
Case 0
itmX.SubItems(7) = "永久"
Case 1
itmX.SubItems(7) = "长期"
Case 2
itmX.SubItems(7) = "短期"
End Select
itmX.SubItems(8) = xml("item_number")
itmX.SubItems(9) = xml("NOTES_OF_ARCHIVIST")
Case 7 '照片档案
Set itmX = form_AnJuan.ListView2.ListItems.Add(, , i)
itmX.SubItems(1) = rs.Fields(0).Value
itmX.SubItems(2) = xml("REFERENCE_CODE_OF_FILE_OFFICE")
If (rs!TITLE_PROPER <> "") Then
itmX.SubItems(3) = rs!TITLE_PROPER
End If
If (rs!PRIMARY_CREATOR <> "") Then
itmX.SubItems(4) = rs!PRIMARY_CREATOR
End If
If (rs!DATE_BEGUN <> "") Then
itmX.SubItems(5) = rs!DATE_BEGUN
End If
If form_AnJuan.List1.ListIndex <> 10 Then
Select Case xml("RETENTION_PERIOD")
Case 0
itmX.SubItems(6) = "永久"
Case 1
itmX.SubItems(6) = "长期"
Case 2
itmX.SubItems(6) = "短期"
End Select
Else
itmX.SubItems(6) = xml("RETENTION_PERIOD")
End If
itmX.SubItems(7) = xml("NEGATIVE_CODE")
itmX.SubItems(8) = xml("DOCUMENT_CODE")
itmX.SubItems(9) = xml("NOTES_OF_ARCHIVIST")
Case 2, 3, 4, 5, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26
Set itmX = form_AnJuan.ListView2.ListItems.Add(, , i)
itmX.SubItems(1) = rs.Fields(0).Value
itmX.SubItems(2) = xml("REFERENCE_CODE_OF_FILE_OFFICE")
If (rs!TITLE_PROPER <> "") Then
itmX.SubItems(3) = rs!TITLE_PROPER
End If
If (rs!PRIMARY_CREATOR <> "") Then
itmX.SubItems(4) = rs!PRIMARY_CREATOR
End If
If (rs!DATE_BEGUN <> "") Then
itmX.SubItems(5) = rs!DATE_BEGUN
End If
If form_AnJuan.List1.ListIndex <> 10 Then
Select Case xml("RETENTION_PERIOD")
Case 0
itmX.SubItems(6) = "永久"
Case 1
itmX.SubItems(6) = "长期"
Case 2
itmX.SubItems(6) = "短期"
End Select
Else
itmX.SubItems(6) = xml("RETENTION_PERIOD")
End If
itmX.SubItems(7) = xml("document_CODE")
itmX.SubItems(8) = xml("item_number")
itmX.SubItems(9) = xml("NOTES_OF_ARCHIVIST")
Case 8, 9 '影视频
Set itmX = form_AnJuan.ListView2.ListItems.Add(, , i)
itmX.SubItems(1) = rs.Fields(0).Value
itmX.SubItems(2) = xml("REFERENCE_CODE_OF_FILE_OFFICE")
If (rs!TITLE_PROPER <> "") Then
itmX.SubItems(3) = rs!TITLE_PROPER
End If
If (rs!PRIMARY_CREATOR <> "") Then
itmX.SubItems(4) = rs!PRIMARY_CREATOR
End If
If (rs!DATE_BEGUN <> "") Then
itmX.SubItems(5) = rs!DATE_BEGUN
End If
If form_AnJuan.List1.ListIndex <> 10 Then
Select Case xml("RETENTION_PERIOD")
Case 0
itmX.SubItems(6) = "永久"
Case 1
itmX.SubItems(6) = "长期"
Case 2
itmX.SubItems(6) = "短期"
End Select
Else
itmX.SubItems(6) = xml("RETENTION_PERIOD")
End If
itmX.SubItems(7) = xml("QUANTITY")
itmX.SubItems(8) = xml("NOTES_OF_ARCHIVIST")
Case 12
Set itmX = form_AnJuan.ListView2.ListItems.Add(, , i)
itmX.SubItems(1) = rs.Fields(0).Value
itmX.SubItems(2) = xml("REFERENCE_CODE_OF_FILE_OFFICE")
If (rs!TITLE_PROPER <> "") Then
itmX.SubItems(3) = rs!TITLE_PROPER
End If
If (rs!PRIMARY_CREATOR <> "") Then
itmX.SubItems(4) = rs!PRIMARY_CREATOR
End If
If (rs!DATE_BEGUN <> "") Then
itmX.SubItems(5) = rs!DATE_BEGUN
End If
If form_AnJuan.List1.ListIndex <> 10 Then
Select Case xml("RETENTION_PERIOD")
Case 0
itmX.SubItems(6) = "永久"
Case 1
itmX.SubItems(6) = "长期"
Case 2
itmX.SubItems(6) = "短期"
End Select
Else
itmX.SubItems(6) = xml("RETENTION_PERIOD")
End If
itmX.SubItems(7) = xml("document_code")
itmX.SubItems(8) = xml("NOTES_OF_ARCHIVIST")
Case Else
Set itmX = form_AnJuan.ListView2.ListItems.Add(, , i)
itmX.SubItems(1) = rs.Fields(0).Value
itmX.SubItems(2) = xml("REFERENCE_CODE_OF_FILE_OFFICE")
If (rs!TITLE_PROPER <> "") Then
itmX.SubItems(3) = rs!TITLE_PROPER
End If
If (rs!PRIMARY_CREATOR <> "") Then
itmX.SubItems(4) = rs!PRIMARY_CREATOR
End If
If (rs!DATE_BEGUN <> "") Then
itmX.SubItems(5) = rs!DATE_BEGUN
End If
If form_AnJuan.List1.ListIndex <> 10 Then
Select Case xml("RETENTION_PERIOD")
Case 0
itmX.SubItems(6) = "永久"
Case 1
itmX.SubItems(6) = "长期"
Case 2
itmX.SubItems(6) = "短期"
End Select
Else
itmX.SubItems(6) = xml("RETENTION_PERIOD")
End If
itmX.SubItems(7) = xml("item_number")
itmX.SubItems(8) = xml("NOTES_OF_ARCHIVIST")
End Select
rs.MoveNext
Wend
rs.Close
'添加记录到列表框
e:
If query <> "file" Then
Unload Me
Else
Me.Hide
End If
Exit Sub
ex:
'MsgBox Err.Number & Err.Description, vbExclamation, ""
MsgBox "请输入正确的数据格式！", 64, ""
If rs.State = 1 Then
rs.Close
End If
End Sub
Private Sub Command2_Click()
On Error GoTo e:
JG = "n"
Call Command1_Click
queryflag = "no"
query = "file"
Dim xlapp As Object, xlbook As Object, xlsheet As Object
Dim strSource, strDestination As String
Dim lop As Integer
Dim numi, numj As Integer
'Dim xlbook As Excel.Workbook
'Dim xlsheet As Excel.Worksheet
Screen.MousePointer = vbHourglass
Set xlapp = CreateObject("Excel.Application")
xlapp.Visible = False
If Right(App.Path, 1) = "\" Then
strSource = App.Path & "excel\gridGC.xls"
strDestination = App.Path & "excel\temp.xls"
Else
strSource = App.Path & "\excel\gridGC.xls"
strDestination = App.Path & "\excel\temp.xls"
End If
FileCopy strSource, strDestination
Set xlbook = xlapp.Workbooks.Open(strDestination)
Set xlsheet = xlbook.Worksheets(1)
lop = 4
'For numj = 1 To ListView2.ColumnHeaders.Count
'xlsheet.Cells(2, numj) = ListView2.ColumnHeaders.Item(numj).Text
'Next numj
'----------------------------------------------------------
If form_Query.Text8.text <> "" Then
xlsheet.Cells(2, 7) = form_Query.Text8.text
End If
'盒号打印-----------------------------------------------
With form_WenJian.ListView2.ListItems
For numi = 1 To .Count
' For numj = 1 To form_WenJian.ListView2.ColumnHeaders.Count - 1
' xlsheet.Cells(lop, numj) = .Item(numi).SubItems(numj) '打印列
' Next numj
xlsheet.Cells(lop, 1) = .Item(numi).SubItems(2)
xlsheet.Cells(lop, 2) = .Item(numi).SubItems(8)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -