dgtogc.frm

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

VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form dgtogc 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "订购数据归并到馆藏"
   ClientHeight    =   5445
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7860
   Icon            =   "dgtogc.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5445
   ScaleWidth      =   7860
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton Command3 
      Caption         =   "馆藏数据备份"
      Height          =   495
      Left            =   3480
      TabIndex        =   6
      Top             =   4800
      Width           =   1455
   End
   Begin VB.TextBox Text1 
      DataField       =   "Expr1000"
      DataSource      =   "Data2"
      Height          =   315
      Left            =   1440
      Locked          =   -1  'True
      TabIndex        =   3
      Top             =   4380
      Width           =   975
   End
   Begin VB.Data Data2 
      Caption         =   "Data2"
      Connect         =   "Access"
      DatabaseName    =   "D:\tscg\bookcgk.mdb"
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      Exclusive       =   0   'False
      Height          =   375
      Left            =   5820
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "select count(*) from 本馆数据"
      Top             =   4380
      Visible         =   0   'False
      Width           =   1875
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   "D:\tscg\bookcgk.mdb"
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      Exclusive       =   0   'False
      Height          =   375
      Left            =   3960
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "xgs"
      Top             =   4440
      Visible         =   0   'False
      Width           =   1815
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   495
      Left            =   5640
      TabIndex        =   2
      Top             =   4800
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "入馆藏"
      Height          =   495
      Left            =   1080
      TabIndex        =   1
      Top             =   4800
      Width           =   1575
   End
   Begin MSDBGrid.DBGrid DBGrid1 
      Bindings        =   "dgtogc.frx":0442
      Height          =   4335
      Left            =   0
      OleObjectBlob   =   "dgtogc.frx":0456
      TabIndex        =   0
      Top             =   0
      Width           =   7815
   End
   Begin VB.Label Label2 
      Caption         =   "条"
      Height          =   315
      Left            =   2460
      TabIndex        =   5
      Top             =   4440
      Width           =   375
   End
   Begin VB.Label Label1 
      Caption         =   "本馆数据共有："
      Height          =   255
      Left            =   180
      TabIndex        =   4
      Top             =   4440
      Width           =   1335
   End
End
Attribute VB_Name = "dgtogc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
  Dim db As Database
  Dim sqlstr As String
  Dim reccount As Long
 On Error GoTo aa
  Set db = Workspaces(0).OpenDatabase("d:\tscg\bookcgk.mdb")
  sqlstr = "insert into 本馆数据 select * from 预采数据 where fbl>0"
  db.Execute sqlstr, dbFailOnError
  reccount = Data1.Recordset.RecordCount
  MsgBox "数据归并完成，共" & reccount & "条记录，请退出！"
  Command1.Enabled = False
  db.Close
  Data2.Refresh
  Exit Sub
aa:
   MsgBox "发生错误33,请与我联系"
   db.Close
End Sub

Private Sub Command2_Click()
  Unload Me
End Sub

Private Sub Command3_Click()
Dim sqlstring As String
Dim filenam As String
Dim fieldtype As Integer

Dim pzhh As Recordset
Dim recnum10 As Long
Dim db As Database
Dim rs As Recordset
Dim recount As Long
recount = 0
recnum10 = 0
On Error Resume Next
'If tablestr <> "采购库" Then
 ' MsgBox "请选择采购库进行查询后，再将查询的数椐转为工作单"
 ' Exit Sub
 ' End If

'rstable.MoveFirst
'If rstable.EOF Then
 '  MsgBox "没找到所要的记录"
 '  Exit Sub
 '  End If
'On Error Resume Next
filenam = ""
filenam = InputBox("请输入备份工作单文件名(不包含路径,文件位于d:\tscg\temp\*.wor下)：")
If filenam = "" Then
  MsgBox "文件名未输入!"
  Exit Sub
  End If
filenam1 = "d:\tscg\temp\" + filenam
If Dir(filenam1) = filenam Then
 
 Kill (filenam1)
End If

Open filenam1 For Output As #1
Set db = Workspaces(0).OpenDatabase("d:\tscg\bookcgk.mdb")
Set rs = db.OpenRecordset("select * from 本馆数据")

If rs.EOF Then
   MsgBox "采购数据库为空,不能转换！"
   
   Close #1
   Kill (filenam1)
   rs.Close
   db.Close
   Exit Sub
   End If
'rs.MoveLast
rs.MoveFirst
'recount = rs.RecordCount
Dim jg1 As String
Do While Not rs.EOF
'读取字段值
  jkzh = Str(rs.Fields("ID").Value)
  sm = rs.Fields("bookname").Value
  jg1 = Trim(rs.Fields("jg").Value)
  xcbl = rs.Fields("bmn").Value
  xcbs = rs.Fields("bms").Value
  zz = rs.Fields("author").Value
  isbn = rs.Fields("isbn").Value
  sxbs = LTrim(Str(rs.Fields("fbl").Value))
  'context = rs.Fields("context").Value
  'provide = rs.Fields("provide").Value
'将此条记录写入文件
  Print #1, "00575nam0 2200229   45"
  If jkzh = Null Then jkzh = ""
  worstr1 = "001" + jkzh
  Print #1, worstr1
  jkzh = ""   '1记录控制号  001$a
  
  If isbn = Null Then isbn = ""
  If jg1 = Null Then jg1 = ""
  worstr2 = "010  @a" + isbn + "@d" + jg1
  Print #1, worstr2
  isbn = ""   '2ISBN号      010$a
  jg1 = ""    '价格        010$d
  
  If sm = Null Then sm = ""
  If zz = Null Then zz = ""
  worstr3 = "2001 @a" + sm + "@f" + zz
  Print #1, worstr3
  sm = ""     '3书名        200$a
    
  If xcbs = Null Then xcbs = ""
  If xcbl = Null Then xcbl = ""
  worstr4 = "210  @c" + xcbs + "@d" + xcbl
  Print #1, worstr4
  xcbs = ""   '出版社      210$c
  xcbl = ""   '出版年      210$d
      
  worstr5 = "330  @a" + context
  Print #1, worstr5
  context = ""
      
  worstr7 = "701  @a" + zz
  Print #1, worstr7
  zz = ""     '作者        200$f,701$a
  
  worstr6 = "801  @a" + provide
  Print #1, worstr6
  provide = ""
      
   
  If sxbs = Null Then sxbs = ""
  worstr8 = "960  @e" + sxbs
  Print #1, worstr8
  sxbs = ""    '所选本数   960$e
  
  Print #1, "***"
  recnum10 = recnum10 + 1
  rs.MoveNext
 Loop
 Close #1
  rs.Close
 db.Close
 MsgBox "转换完成,共转换数据:" + Str(recnum10) + "条"
End Sub