复件 frmimport.frm

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

Next i
txtMsg.Text = "导入成功!"
End Sub

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 As Integer
  Dim i, NewID, msgUpdate As Integer
  Dim s_Date As Date
  Dim DataUpdate, FileFound, cGo As Boolean
  Dim sQuery As String
  
  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
          DataUpdate = False
          If IsNull(dh) Then cGo = False Else cGo = True
          If adoRst.RecordCount <> 0 Then
             adoRst.MoveFirst
             dh = LTrim(Trim(dh))
             FileFound = False
             adoRst.Find "档号 Like '" & dh & "'"
             If FileLevel = 0 Then
                If FileType = "照片" Then
                   '照片档案(文件)
                   If Not adoRst.EOF And Not adoRst.BOF Then
                      If IsNull(.Fields!照片号) And IsNull(.Fields!底片号) And IsNull(.Fields!摄影者) Then
                         '总说明
                         Do Until adoRst.EOF
                            If LTrim(Trim(adoRst!档号)) <> dh Then
                               Exit Do
                            End If
                            If adoRst!FileType = -1 And .Fields!顺序号 = adoRst!顺序号 Then
                               FileFound = True
                               Exit Do
                            End If
                            adoRst.MoveNext
                         Loop
                      Else
                         '分类说明
                         Do Until adoRst.EOF
                            If LTrim(Trim(adoRst!档号)) <> dh Then
                               Exit Do
                            End If
                            If adoRst!FileType = 0 And .Fields!顺序号 = adoRst!顺序号 And TransZph(.Fields!照片号) = adoRst!照片号 Then
                               FileFound = True
                               Exit Do
                            End If
                            adoRst.MoveNext
                         Loop
                      End If
                   End If
                Else
                   '卷内文件级
                   If Not adoRst.EOF And Not adoRst.BOF Then
                      Do Until adoRst.EOF
                         If LTrim(Trim(adoRst!档号)) <> dh Then
                            Exit Do
                         End If
                         If .Fields!页号 = adoRst.Fields!页号 And .Fields!正题名 = adoRst!题名 Then
                            FileFound = True
                            Exit Do
                         End If
                         adoRst.MoveNext
                      Loop
                   End If
                End If
             Else
                '其它档案级别(案卷、归档文件)
                If Not adoRst.EOF And Not adoRst.BOF Then
                   FileFound = True
                End If
             End If
             If FileFound Then      '目标数据库中存在该记录
                msgUpdate = MsgBox("存在有相同的记录 " & dh & " ，是否更新该记录数据？", vbYesNoCancel)
                If msgUpdate = vbCancel Then Exit Do
                If msgUpdate = vbNo Then cGo = False
             End If
          End If
          If cGo Then
             If Not DataUpdate 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
     End With
  End If
  adoRst.Close
  adoDBFRst.Close
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