dbffile.frm

出版社图书出货管理系统,包括图书的出库,入库,结果输出

      Width           =   975
   End
   Begin VB.Label Label4 
      Caption         =   "作者:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   5520
      TabIndex        =   6
      Top             =   3360
      Width           =   975
   End
   Begin VB.Label Label3 
      Caption         =   "书名:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2940
      TabIndex        =   4
      Top             =   3360
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "ISBN号:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   3360
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "*.dbf"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3600
      TabIndex        =   2
      Top             =   120
      Width           =   3255
   End
End
Attribute VB_Name = "dbffile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
  Dim workingfile As String  'DBF全文件名
  Dim filelast As String    '文件名
  Dim filefirst As String      '路径
  Dim fieldnum As Integer
  Dim recyes As Integer
  recyes = 0
  On Error GoTo aa
   CommonDialog1.ShowOpen
  
  workingfile = LTrim$(RTrim$(UCase$(CommonDialog1.filename)))
   Label1.Caption = workingfile
  If workingfile = "" Then
   Exit Sub
   End If
  If UCase(Right(workingfile, 3)) <> "DBF" Then
     MsgBox "不是dbf文件!"
     Exit Sub
     End If
  
 If Not Filexists(workingfile) Then
  '  MsgBox "文件不存在,请重新输入。"
    Exit Sub
    End If
filelast = CommonDialog1.FileTitle
filefirst = Left(CommonDialog1.filename, Len(CommonDialog1.filename) - Len(filelast))

 Data1.Connect = "FoxPro 3.0;"
 Data1.DatabaseName = filefirst
 Data1.RecordSource = filelast
 Data1.Refresh
 'On Error Resume Next
 '对字段
 Data1.Recordset.MoveFirst
 fieldnum = Data1.Recordset.Fields.Count
 Combo1.Clear
 Combo2.Clear
 Combo3.Clear
 Combo4.Clear
 Combo5.Clear
 Combo6.Clear
 Combo7.Clear
 
 Combo1.AddItem "无字段对应"
 Combo2.AddItem "无字段对应"
 Combo3.AddItem "无字段对应"
 Combo4.AddItem "无字段对应"
 Combo5.AddItem "无字段对应"
 Combo6.AddItem "无字段对应"
 Combo7.AddItem "无字段对应"
 Combo1.Text = "无字段对应"
 Combo2.Text = "无字段对应"
 Combo3.Text = "无字段对应"
 Combo4.Text = "无字段对应"
 Combo5.Text = "无字段对应"
 Combo6.Text = "无字段对应"
 Combo7.Text = "无字段对应"
 
 For i = 0 To fieldnum - 1
  Combo1.AddItem Data1.Recordset.Fields(i).Name
  Combo2.AddItem Data1.Recordset.Fields(i).Name
  Combo3.AddItem Data1.Recordset.Fields(i).Name
  Combo4.AddItem Data1.Recordset.Fields(i).Name
  Combo5.AddItem Data1.Recordset.Fields(i).Name
  Combo6.AddItem Data1.Recordset.Fields(i).Name
  Combo7.AddItem Data1.Recordset.Fields(i).Name
 Next i
 Command2.Enabled = True
 Exit Sub
aa:
 MsgBox Err.Description
 
End Sub

Private Sub Command2_Click()
  Dim recnum As Long
  Dim isbn As String
  Dim sm As String
  Dim author As String
  Dim cbs As String
  Dim cbn As String
  Dim jg As String
  Dim recyes As Long
  Dim fbl As String
  Dim isbnno As String
  Dim recordno As Long
  Dim isbnspace As String
  isbnspace = ""
  recordno = 0
  isbnno = ""
  recyes = 0
  recnum = 0
 ' On Error Resume Next
 ' If Combo1.Text = "无字段对应" And Combo2.Text = "无字段对应" And Combo3.Text = "无字段对应" Then
  If Combo2.Text = "无字段对应" Then
    MsgBox "您还没有选字段书名"
    Exit Sub
    End If
 ' Label9.Caption = "正在处理数据,请稍候!"
  '从DBF中取数据
  recnum = Data1.Recordset.RecordCount
  Data1.Recordset.MoveFirst
 
  For i = 0 To recnum - 1
  isbn = ""
  If Combo1.Text <> "无字段对应" Then
   isbn = Data1.Recordset.Fields(Combo1.Text).Value
   isbn = Right(isbn, Len(isbn) - 3)
   isbn = RTrim(LTrim(isbndel(isbn)))
   isbn = Trim(Left(isbndelt(isbn), 10))
   
     If Len(isbn) <> 10 And (worktok = "预采库") Then
       isbnspace = isbnspace & "/" & Str(i) & "(" & isbn & ")"   '需报告出来
       If Option1.Value <> True Then
       GoTo aa1
       End If
     End If
     If (Left(isbn, 1) <> "7") And (worktok = "预采库") Then
      isbnspace = isbnspace & "/" & isbn '错误ISBN报告
      If Option1.Value <> True Then
      GoTo aa1
      End If
     End If
  End If
  sm = ""
  If Combo2.Text <> "无字段对应" Then
  sm = Data1.Recordset.Fields(Combo2.Text).Value
  End If
  author = ""
  If Combo3.Text <> "无字段对应" Then
  author = Data1.Recordset.Fields(Combo3.Text).Value
  End If
  cbs = ""
  If Combo4.Text <> "无字段对应" Then
  cbs = Data1.Recordset.Fields(Combo4.Text).Value
  End If
  cbn = ""
  If Combo5.Text <> "无字段对应" Then
  cbn = Data1.Recordset.Fields(Combo5.Text).Value
  End If
  jg = ""
  If Combo6.Text <> "无字段对应" Then
  jg = Data1.Recordset.Fields(Combo6.Text).Value
  jg = Trim(pricedel(jg))
  End If
  fbl = ""
  If Combo7.Text <> "无字段对应" Then
  fbl = Data1.Recordset.Fields(Combo7.Text).Value
  End If
 '数据加入数据库
 If worktok = "预采库" Then
  If Option1.Value = True Then
    Data2.Recordset.FindFirst ("isbn='abcdefghijklmnopqrstuvwd'")

  End If
  If Option2.Value = True Then
   Data2.Recordset.FindFirst ("isbn='" & isbn & "'")

  End If
  If Option3.Value = True Then
   Data2.Recordset.FindFirst ("isbn='" & isbn & "' and bookname='" & sm & "'")

  End If
  If Option4.Value = True Then
     Data2.Recordset.FindFirst ("isbn='" & isbn & "' and bookname='" & sm & "' and jg='" & jg & "'")
  End If
    If Data2.Recordset.NoMatch Then
     Data2.Recordset.AddNew
     Data2.Recordset("bookname") = LTrim$(RTrim$(Left$(sm, 50)))
     Data2.Recordset("author") = LTrim$(RTrim$(Left$(author, 25)))
     Data2.Recordset("isbn") = LTrim$(RTrim$(Left$(isbn, 15)))
     Data2.Recordset("bms") = LTrim$(RTrim$(Left$(cbs, 25)))
     Data2.Recordset("bmn") = LTrim$(RTrim$(Left$(cbn, 10)))
     Data2.Recordset("jg") = LTrim$(RTrim$(Left$(jg, 15)))
     Data2.Recordset("fbl") = LTrim$(RTrim$(Left$(fbl, 5)))
     Data2.Recordset.Update
      recyes = recyes + 1
     Else '与预采数据重复
      isbnno = isbnno & "/" & isbn
      recordno = recordno + 1
     End If
  Else '馆藏库
     Data2.Recordset.AddNew
     Data2.Recordset("bookname") = LTrim$(RTrim$(Left$(sm, 50)))
     Data2.Recordset("author") = LTrim$(RTrim$(Left$(author, 25)))
     Data2.Recordset("isbn") = LTrim$(RTrim$(Left$(isbn, 15)))
     Data2.Recordset("bms") = LTrim$(RTrim$(Left$(cbs, 25)))
     Data2.Recordset("bmn") = LTrim$(RTrim$(Left$(cbn, 10)))
     Data2.Recordset("jg") = LTrim$(RTrim$(Left$(jg, 15)))
     Data2.Recordset("fbl") = LTrim$(RTrim$(Left$(fbl, 5)))
     Data2.Recordset.Update
      recyes = recyes + 1
  End If
     
    
     Me.Caption = "正在处理，请稍等！" & Str(i)
     
     Data1.Recordset.MoveNext
  
aa1:
  Next i
  MsgBox "数据处理完成,有" & Str(recyes) & "条数据转入" & worktok
 Text1.Visible = True
 If worktok = "预采库" Then
 Text1.Text = "数据处理完成,有数据条数：" & recnum & "；共转入" & Str(recyes) & "条数据到" & worktok & "，有" & recordno & "条重复记录未转入，其ISBN为：" & isbnno & vbCrLf & "|错误数据未转入：" & isbnspace
 Else
  Text1.Text = "数据处理完成,有数据条数：" & recnum & "；共转入" & Str(recyes) & "条数据到" & worktok
 End If
  

 Command2.Enabled = False
 Exit Sub
aa:
  MsgBox Err.Description
End Sub

Private Sub Command3_Click()
 Unload dbffile
 
End Sub

Private Sub Form_Load()
  Text1.Visible = False
  Command2.Enabled = False
   If worktok = "馆藏" Then
     Data2.RecordSource = "本馆数据"
     dbffile.Caption = "转入本馆数据"
  End If
  If worktok = "预采库" Then
   Data2.RecordSource = "预采数据"
    dbffile.Caption = "转入预采数据"
  End If
  Data2.Refresh
  
End Sub