form5.frm

一、 设计构想： 为减轻财政局非税收入管理处票据准购薄管理工作量

    SQL = "select * from wjxx where mc='" & Text1(1).Text & "'"
    rs.Open SQL, conn, 1, 1
    If Not (rs.EOF) Then
    MDIForm1.StatusBar1.Panels(1).Text = "文件目录已存在"
    rs.Close
    Exit Sub
    End If
    rs.Close
End If
    SQL = "select * from wjxx where id=" & wjID
    rs.Open SQL, conn, 1, 3
        If rs.EOF Then
        rs.AddNew
        Call updirs("", Text1(1).Text, 0)
        rs("mc") = Text1(1).Text
        rs("dir") = Text1(1).Text
        Else
            If rs("mc") <> Text1(1).Text Then
                If MsgBox("你确定要修改依据文件名吗？(修改依据文件可能导致收费项目中个别选择此文件项目找不到该文档)", vbYesNo) = vbYes Then
                Call updirs(rs("mc"), Text1(1).Text, 1)
                rs("mc") = Text1(1).Text
                rs("dir") = Text1(1).Text
                End If
            Else
            Call updirs("", Text1(1).Text, 0)
            End If
        End If
    rs("bh") = Text1(0).Text
    rs.Update
    rs.Close
    If Err.Number = 0 Then
    Pub_DIR = ""
    Call RefillList(ListView1)
Command2.Enabled = False

Text1(0).Text = ""
Text1(1).Text = ""
Text1(2).Text = ""
wjID = 0
    MDIForm1.StatusBar1.Panels(1).Text = "操作成功"
    Else
        MsgBox ("操作失败")
    End If
End Sub

Sub updirs(sdir, ndir, opea)
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject")
Text1(2).Text = Pub_path
Text1(2).Text = Text1(2).Text & sdir
sdir = Text1(2).Text
Text1(2).Text = Pub_path
Text1(2).Text = Text1(2).Text & ndir
ndir = Text1(2).Text
Select Case opea
Case 0
If Not fs.FolderExists(ndir) Then
fs.CreateFolder (ndir)
End If
Case 1
If fs.FolderExists(sdir) Then
fs.MoveFolder sdir, ndir
Else
fs.CreateFolder (ndir)
End If
Case 2
If fs.FolderExists(sdir) Then
fs.DeleteFolder (sdir)
End If
End Select
Set fs = Nothing
End Sub

Private Sub Command2_Click()
On Error Resume Next
If wjID = 0 Then
MDIForm1.StatusBar1.Panels(1).Text = "未选择文件，不允许操作"
Exit Sub
End If
SQL = "select * from wjxx where id=" & wjID
rs.Open SQL, conn, 1, 3
Call updirs(rs("mc"), "", 2)
rs.Delete
rs.Close
If Err.Number = 0 Then
Call RefillList(ListView1)
Text1(0).Text = ""
Text1(1).Text = ""
wjID = 0
Command2.Enabled = False
Else
MDIForm1.StatusBar1.Panels(1).Text = "数据库删除失败." & Err.Description
End If
End Sub

Private Sub Command3_Click()
On Error Resume Next
Form1.Text3.Text = Pub_DIR
Me.Hide
End Sub

Private Sub Command4_Click()
On Error Resume Next
Text1(0).Text = ""
Text1(1).Text = ""
wjID = 0
Command2.Enabled = False
End Sub

Private Sub Command5_Click()
tmp_text = Text1(2).Text
Text1(2).Text = Pub_DIR
tmp_path = Text1(2).Text
Text1(2).Text = Pub_path
Text1(2).Text = Text1(2).Text & tmp_path
Shell "EXPLORER.EXE " & Text1(2).Text
Text1(2).Text = tmp_text
End Sub

Private Sub Form_Load()
On Error Resume Next
    connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\GLNHHY.DLL;Persist Security Info=False"
    Set conn = New ADODB.Connection
    conn.Open connstr
    Set rs = New ADODB.Recordset
    If Not (Pub_DIR <> "") Then
    Pub_DIR = ""
    Command2.Enabled = False
    End If
Call RefillList(ListView1)
Call RefillList2(Pub_DIR)
End Sub



Private Sub RefillList(ByVal lv As ListView)
On Error Resume Next
   Dim clm As ColumnHeader
   Dim itm As ListItem
   Dim i As Long, j As Long
   lv.ListItems.Clear
   lv.ColumnHeaders.Clear
   lv.View = lvwReport
   lv.LabelEdit = lvwManual
   '
   '
   Set clm = lv.ColumnHeaders.Add(, , "ID", ListView1.Width / 100 * 10)
   Set clm = lv.ColumnHeaders.Add(, , "文件编号", ListView1.Width / 100 * 22, 2)
   Set clm = lv.ColumnHeaders.Add(, , "文件名称", ListView1.Width / 100 * 66)
i = 0
SQL = "select * from wjxx"
rs.Open SQL, conn, 1, 1
If rs.EOF Then
rs.Close
Exit Sub
End If
Do Until rs.EOF
If rs.EOF Then Exit Do
i = i + 1
listselected = False
    If Pub_DIR = rs("dir") Then
    listselected = True
    Text1(0).Text = rs("bh")
    Text1(1).Text = rs("mc")
    wjID = rs("id")
    Text2.Text = "前选择依据文件：" & Chr(13) & Chr(10) & Text1(1).Text
    Pub_DIR = Text1(1).Text
    End If
      Set itm = lv.ListItems.Add(, , rs("id"))
      itm.SubItems(1) = rs("bh") & ""
      itm.SubItems(2) = rs("mc") & ""
rs.MoveNext
Loop
rs.Close
If listselected Then
lv.ListItems(Pub_DIR).Selected = True
Command2.Enabled = True
Call RefillList2(Pub_DIR)
End If
End Sub

Private Sub RefillList2(ByVal dirs As String)
On Error Resume Next
If dirs = "" Then Exit Sub
   Dim lv As ListView
   Dim clm As ColumnHeader
   Dim itm As ListItem
   Dim i As Long, j As Long
   Set lv = ListView2
   lv.ListItems.Clear
   lv.ColumnHeaders.Clear
   lv.Sorted = True
   lv.SortKey = 0
   lv.View = lvwIcon
   lv.LabelEdit = lvwManual
   '
   '
   Set clm = lv.ColumnHeaders.Add(, , "文件名称", ListView1.Width)
i = 0

tmp_text = Text1(2).Text
Text1(2).Text = dirs
tmp_path = Text1(2).Text
Text1(2).Text = Pub_path
Text1(2).Text = Text1(2).Text & tmp_path
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(Text1(2).Text)
    Set fc = f.Files
    For Each f1 In fc
    fext = LCase(Right(f1.Name, Len(f1.Name) - InStr(f1.Name, ".")))
    fName = LCase(Left(f1.Name, InStr(f1.Name, ".") - 1))
    Select Case fext
    Case "jpg", "jpeg"
    Set itm = lv.ListItems.Add(, Text1(2).Text & "\" & f1.Name, fName)
    itm.Icon = 1
    Case "bmp"
    Set itm = lv.ListItems.Add(, Text1(2).Text & "\" & f1.Name, fName)
    itm.Icon = 2
    Case "gif"
    Set itm = lv.ListItems.Add(, Text1(2).Text & "\" & f1.Name, fName)
    itm.Icon = 3
    End Select
    Next
Text1(2).Text = tmp_text
End Sub



Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
On Error Resume Next
ListView1.SortKey = ColumnHeader.Index - 1
ListView1.Sorted = True
If ListView1.SortOrder = lvwDescending Then
ListView1.SortOrder = lvwAscending
Else
ListView1.SortOrder = lvwDescending
End If
End Sub

Private Sub ListView1_DblClick()
On Error Resume Next
Pub_DIR = ListView1.ListItems(ListView1.SelectedItem.Index).SubItems(3)
Form1.Text3.Text = Pub_DIR
Me.Hide
End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
On Error Resume Next
If Err.Number = 3705 Then rs.Close
SQL = "select * from wjxx where id=" & Item.Text
rs.Open SQL, conn, 1, 1
If Not (rs.EOF) Then
wjID = CLng(rs("id"))
Text1(0).Text = rs("bh")
Text1(1).Text = rs("mc")
Text2.Text = "前选择依据文件：" & Chr(13) & Chr(10) & Text1(1).Text
Pub_DIR = Text1(1).Text
End If
rs.Close
Command2.Enabled = True
Call RefillList2(Pub_DIR)
End Sub

Private Sub Text3_DblClick()
On Error Resume Next
Call goform(Form5, "0,1,2")
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
On Error Resume Next
KeyAscii = 0
End Sub

Private Sub ListView2_DblClick()
On Error Resume Next
Pub_file = ListView2.ListItems(ListView2.SelectedItem.Index).Key
Call goform(Form6, "0,1,2")
End Sub