frmimport.frm

档案管理系统,使用vb6+access数据库开发

Private Function CheckFile(FileName As String) As Boolean
'检查是否存在文件
Dim oFSO As FileSystemObject
Dim oFile As File
Dim sFile As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFile = Trim(FileName)
CheckFile = oFSO.FileExists(sFile)
End Function

Private Sub CopyFile(FileType As String)
  '导入数据
  Dim dh, f_Date, l_Date As String
  Dim f_h, l_h, NewID As Integer
  Dim s_Date As Date
  Dim FileFound As Boolean
  Dim f_Text(3), l_Text(3)
  
  Set adoRst = New ADODB.Recordset
  Set adoRst.ActiveConnection = adoCon
  adoRst.CursorType = adOpenKeyset
  adoRst.LockType = adLockOptimistic
  
  Set adoDBFRst = New ADODB.Recordset
  Set adoDBFRst.ActiveConnection = adoDBFCon
  adoDBFRst.CursorType = adOpenKeyset
  adoDBFRst.LockType = adLockOptimistic

  adoRst.Open TabelFile
  adoDBFRst.Open DbfFile
  
  If adoDBFRst.RecordCount = 0 Then
     MsgBox "档案没有任何记录!"
  Else
     With adoDBFRst
       .MoveFirst
       Do Until .EOF
          If FileLevel = 2 Then
             dh = .Fields!档号
          Else
             dh = .Fields!案卷号
          End If
          If Not IsNull(dh) Then
             adoRst.AddNew
             Select Case FileLevel
                    Case 0                     '导入卷内文件级数据
                         If FileType = "照片" Then
                            adoRst.Fields("档号") = dh
                            adoRst.Fields("顺序号") = .Fields!顺序号
                            adoRst.Fields("题名") = .Fields!题名
                            If IsNull(.Fields!照片号) And IsNull(.Fields!底片号) And IsNull(.Fields!摄影者) Then
                               '照片总说明
                               adoRst.Fields("张数") = .Fields!张数
                               adoRst.Fields("FileType") = -1
                            Else
                               '照片分类说明
                               adoRst.Fields("照片号") = TransZph(.Fields!照片号)
                               adoRst.Fields("底片号") = .Fields!底片号
                               adoRst.Fields("摄影者") = .Fields!摄影者
                               adoRst.Fields("拍摄时间") = TransDate(.Fields!拍摄时间, .Fields!年, .Fields!月, .Fields!日)
                               adoRst.Fields("FileType") = 0
                            End If
                         Else
                            adoRst.Fields("分类号") = .Fields!分类号
                            adoRst.Fields("目录号") = .Fields!目录号
                            adoRst.Fields("全宗号") = LTrim(Str(.Fields!全宗号))
                            adoRst.Fields("缩微号") = .Fields!缩微号
                            adoRst.Fields("顺序号") = .Fields!顺序号
                            adoRst.Fields("档号") = dh
                            adoRst.Fields("文件编号") = .Fields!文件编号
                            adoRst.Fields("形成日期") = TransDate(.Fields!形成日期, True, True, .Fields!形成日)
                            adoRst.Fields("备注") = .Fields!备注
                            adoRst.Fields("规格") = .Fields!规格
                            adoRst.Fields("份数") = .Fields!份数
                            adoRst.Fields("页号") = .Fields!页号
                            adoRst.Fields("最后张次") = .Fields!最后张次
                            adoRst.Fields("页数") = .Fields!页数
                            adoRst.Fields("题名") = .Fields!正题名
                            adoRst.Fields("摘要") = .Fields!摘要
                            adoRst.Fields("保管期限") = .Fields!保管期限
                            adoRst.Fields("文本类别") = .Fields!文本
                            adoRst.Fields("密级") = .Fields!密级
                            adoRst.Fields("存档情况") = .Fields!存档情况
                            adoRst.Fields("责任者1") = TransZZ(.Fields!责任者1, 0)
                            adoRst.Fields("责任者2") = TransZZ(.Fields!责任者2, 0)
                            adoRst.Fields("责任者3") = TransZZ(.Fields!责任者3, 0)
                            adoRst.Fields("主题词1") = TransZZ(.Fields!主题词1, 1)
                            adoRst.Fields("主题词2") = TransZZ(.Fields!主题词2, 1)
                            adoRst.Fields("主题词3") = TransZZ(.Fields!主题词3, 1)
                            adoRst.Fields("主题词4") = TransZZ(.Fields!主题词4, 1)
                            adoRst.Fields("主题词5") = TransZZ(.Fields!主题词5, 1)
                            adoRst.Fields("FileType") = FileType
                         End If
                         adoRst.Update
                    Case 1                     '导入案卷级数据
                         adoRst.Fields("分类号") = .Fields!分类号
                         adoRst.Fields("全宗号") = LTrim(Str(.Fields!全宗号))
                         adoRst.Fields("目录号") = .Fields!目录号
                         adoRst.Fields("年度") = .Fields!年度
                         adoRst.Fields("档号") = dh
                         adoRst.Fields("档案室代号") = .Fields!档案室代号
                         adoRst.Fields("分类名") = .Fields!分类号
                         adoRst.Fields("开始日期") = TransDate(.Fields!开始日期, True, True, .Fields!开始日)
                         adoRst.Fields("最后日期") = TransDate(.Fields!最后日期, True, True, .Fields!最后日)
                         adoRst.Fields("规格") = .Fields!规格
                         adoRst.Fields("份数") = .Fields!份数
                         adoRst.Fields("页数") = .Fields!页数
                         adoRst.Fields("正题名") = .Fields!正题名
                         adoRst.Fields("摘要") = .Fields!摘要
                         adoRst.Fields("保管期限") = .Fields!保管期限
                         adoRst.Fields("密级") = .Fields!密级
                         adoRst.Fields("存档情况") = .Fields!存档情况
                         adoRst.Fields("全宗名称") = TransZZ(.Fields!全宗名称, 0)
                         adoRst.Fields("归档单位") = TransZZ(.Fields!归档单位, 0)
                         adoRst.Fields("主题词1") = TransZZ(.Fields!主题词1, 1)
                         adoRst.Fields("主题词2") = TransZZ(.Fields!主题词2, 1)
                         adoRst.Fields("主题词3") = TransZZ(.Fields!主题词3, 1)
                         adoRst.Fields("主题词4") = TransZZ(.Fields!主题词4, 1)
                         adoRst.Fields("主题词5") = TransZZ(.Fields!主题词5, 1)
                         adoRst.Fields("FileType") = FileType
                         adoRst.Update
                    Case 2                     '导入归档文件级数据
                         adoRst.Fields("全宗号") = LTrim(Str(.Fields!全宗号))
                         adoRst.Fields("目录号") = .Fields!目录号
                         adoRst.Fields("档号") = dh
                         adoRst.Fields("文件编号") = .Fields!文件编号
                         adoRst.Fields("形成日期") = TransDate(.Fields!形成日期, True, True, .Fields!Day)
                         adoRst.Fields("责任者1") = TransZZ(.Fields!责任者1, 0)
                         adoRst.Fields("责任者2") = TransZZ(.Fields!责任者2, 0)
                         adoRst.Fields("责任者3") = TransZZ(.Fields!责任者3, 0)
                         adoRst.Fields("保管期限") = .Fields!保管期限
                         adoRst.Fields("密级") = .Fields!密级
                         adoRst.Fields("存档情况") = .Fields!存档情况
                         adoRst.Fields("规格") = .Fields!规格
                         adoRst.Fields("份数") = .Fields!份数
                         adoRst.Fields("页数") = .Fields!页数
                         adoRst.Fields("正题名") = .Fields!正题名
                         adoRst.Fields("摘要") = .Fields!摘要
                         adoRst.Fields("主题词1") = TransZZ(.Fields!主题词1, 1)
                         adoRst.Fields("主题词2") = TransZZ(.Fields!主题词2, 1)
                         adoRst.Fields("主题词3") = TransZZ(.Fields!主题词3, 1)
                         adoRst.Fields("主题词4") = TransZZ(.Fields!主题词4, 1)
                         adoRst.Fields("主题词5") = TransZZ(.Fields!主题词5, 1)
                         adoRst.Fields("FileType") = FileType
                         adoRst.Update
             End Select
          End If
          .MoveNext
       Loop
       .Close
     End With
     With adoRst
       .Close
       .Open TabelFile
       If .RecordCount <> 0 Then
          .MoveFirst
          Do Until .EOF
             If FileLevel = 0 Then
                '文件级档案
                If FileType = "照片" Then
                   '照片档案(文件)
                   If .Fields!FileType = -1 Then
                      '总说明
                      f_Text(0) = LTrim(Trim(.Fields!档号))
                      f_Text(1) = LTrim(Trim(.Fields!顺序号))
                      .MoveNext
                      If Not .EOF Then
                         l_Text(0) = LTrim(Trim(.Fields!档号))
                         l_Text(1) = LTrim(Trim(.Fields!顺序号))
                         .MovePrevious
                         If f_Text(0) = l_Text(0) And f_Text(1) = l_Text(1) Then
                            .Delete adAffectCurrent
                         End If
                      End If
                   Else
                      '分类说明
                      f_Text(0) = LTrim(Trim(.Fields!顺序号))
                      f_Text(1) = LTrim(Trim(.Fields!照片号))
                      .MoveNext
                      If Not .EOF Then
                         l_Text(0) = LTrim(Trim(.Fields!顺序号))
                         l_Text(1) = LTrim(Trim(.Fields!照片号))
                         .MovePrevious
                         If f_Text(0) = l_Text(0) And f_Text(1) = l_Text(1) Then
                            .Delete adAffectCurrent
                         End If
                      End If
                   End If
                Else
                   '卷内文件级
                      f_Text(0) = LTrim(Trim(.Fields!档号))
                      f_Text(1) = LTrim(Trim(.Fields!页号))
                      f_Text(2) = LTrim(Trim(.Fields!题名))
                      .MoveNext
                      If Not .EOF Then
                         l_Text(0) = LTrim(Trim(.Fields!档号))
                         l_Text(1) = LTrim(Trim(.Fields!页号))
                         l_Text(2) = LTrim(Trim(.Fields!题名))
                         .MovePrevious
                         If f_Text(0) = l_Text(0) And f_Text(1) = l_Text(1) And f_Text(2) = l_Text(2) Then
                            .Delete adAffectCurrent
                         End If
                      End If
                End If
             Else
                '其它档案级别(案卷、归档文件)
                f_Text(0) = LTrim(Trim(.Fields!档号))
                .MoveNext
                If Not .EOF Then
                   l_Text(0) = LTrim(Trim(.Fields!档号))
                  .MovePrevious
                  If f_Text(0) = l_Text(0) Then
                     .Delete adAffectCurrent
                  End If
                End If
             End If
             If Not .EOF Then
                .MoveNext
             End If
          Loop
       End If
       .Close
     End With
  End If
End Sub

Private Function TransDate(tDate As Variant, iYear As Boolean, iMonth As Boolean, iDay As Boolean) As String
'处理旧有数据库中的日期问题，转换成字符串
Dim t_Date As String
If IsDate(tDate) Then
   If iYear Then
      t_Date = LTrim(Str$(Year(tDate)))
   End If
   If iMonth Then
      t_Date = t_Date + "." + Right(Str(Month(tDate) + 100), 2)
   End If
   If iDay Then
      t_Date = t_Date + "." + Right(Str(Day(tDate) + 100), 2)
   End If
Else
   t_Date = ""
End If
TransDate = t_Date
End Function

Private Function TransZph(tZph As Variant) As Long
Dim f_m, l_m As Integer
f_m = InStr(tZph, "(")
l_m = InStr(tZph, ")")
If f_m = 0 Or l_m = 0 Or f_m > l_m Then
   TransZph = 0
Else
   TransZph = Val(Mid$(tZph, f_m + 1, l_m - f_m))
End If
End Function

Private Function TransZZ(tZ As Variant, ZZ As Byte) As Long
'处理责任者、主题词的转换
Dim tID As Long
Dim NewZ As Boolean
Dim sZ, sID As String

Set adoZRst = New ADODB.Recordset
Set adoZRst.ActiveConnection = adoCon
adoZRst.CursorType = adOpenKeyset
adoZRst.LockType = adLockOptimistic

tZ = LTrim(Trim(tZ))
If IsNull(tZ) Then
   TransZZ = -1         '返回空值 -1
   Exit Function
Else
   tID = 0
   NewZ = True
End If

sZ = IIf(ZZ = 0, "Zr", "Ztc")
sID = IIf(ZZ = 0, "ZrID", "ZtcID")
With adoZRst
  .Open "Select * From " & sZ & " Order By " & sID
  If .RecordCount <> 0 Then
     .MoveFirst
     Do Until .EOF
        If .Fields(sID) = tID Then tID = tID + 1
        If LTrim(Trim(.Fields(sZ))) = tZ Then
           NewZ = False
           tID = .Fields(sID)
           Exit Do
        End If
        .MoveNext
     Loop
     .MoveFirst
  End If
  If NewZ Then
     .AddNew
     .Fields(sID) = tID
     .Fields(sZ) = tZ
     .Update
  End If
  .Close
End With
TransZZ = tID
End Function

Private Sub Form_Load()
  Set adoCon = New ADODB.Connection
  adoCon.Open "PmData", "Admin"

  Set adoDBFCon = New ADODB.Connection
  adoDBFCon.Open "dBASE Files", "Admin"

  choseFile = 0
End Sub

Private Sub obLevel_Click(Index As Integer)
FileLevel = Index
End Sub

Private Sub TextDIR_LostFocus()
Dim oFSO As FileSystemObject
Dim oFolder As Folder
Dim sFolder As String

If TextDIR.Text = "" Then
   MsgBox "请输入路径"
   TextDIR.SetFocus
Else
   If cmdGO.Enabled = False Then Exit Sub
   Set oFSO = CreateObject("Scripting.FileSystemObject")
   sFolder = Trim(TextDIR.Text)
   If oFSO.FolderExists(sFolder) = True Then
      cmdGO.SetFocus
   Else
      MsgBox "文件夹 " + sFolder + " 不存在!"
      TextDIR.SetFocus
   End If
End If
End Sub