📄 tsdinggou.frm
字号:
VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form dgoutput1
BorderStyle = 1 'Fixed Single
Caption = "订购数据输出"
ClientHeight = 6810
ClientLeft = 45
ClientTop = 330
ClientWidth = 10275
Icon = "tsdinggou.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6810
ScaleWidth = 10275
StartUpPosition = 1 'CenterOwner
Begin VB.CommandButton Command6
Caption = "编目MARC输出"
Height = 375
Left = 5040
TabIndex = 13
Top = 6360
Width = 1335
End
Begin VB.CommandButton Command5
Caption = "采访Marc输出"
Height = 375
Left = 0
TabIndex = 12
Top = 6360
Width = 1455
End
Begin MSDBGrid.DBGrid DBGrid1
Bindings = "tsdinggou.frx":0442
Height = 5535
Left = 0
OleObjectBlob = "tsdinggou.frx":0456
TabIndex = 0
Top = 720
Width = 10215
End
Begin VB.CommandButton Command4
Caption = "统计"
Height = 375
Left = 6600
TabIndex = 11
Top = 6360
Width = 1335
End
Begin VB.CommandButton Command3
Caption = "退出"
Height = 375
Left = 9000
TabIndex = 10
Top = 6360
Width = 1215
End
Begin VB.CommandButton Command2
Caption = "采购EXCEL输出"
Height = 375
Left = 3240
TabIndex = 9
Top = 6360
Width = 1575
End
Begin VB.CommandButton Command1
Caption = "采访工作单输出"
Height = 375
Left = 1590
TabIndex = 8
Top = 6360
Width = 1575
End
Begin VB.Data Data2
Caption = "Data2"
Connect = "Access"
DatabaseName = "D:\tscg\bookcgk.mdb"
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 345
Left = 1920
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "tongji"
Top = 360
Visible = 0 'False
Width = 2415
End
Begin VB.TextBox Text3
Height = 375
Left = 8280
TabIndex = 7
Top = 120
Width = 1935
End
Begin VB.TextBox Text2
DataField = "cs"
DataSource = "Data2"
Height = 375
Left = 6360
Locked = -1 'True
TabIndex = 6
Text = "Text2"
Top = 120
Width = 1215
End
Begin VB.TextBox Text1
DataField = "zs"
DataSource = "Data2"
Height = 375
Left = 4200
Locked = -1 'True
TabIndex = 5
Text = "Text1"
Top = 120
Width = 1335
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 = 2760
Options = 0
ReadOnly = -1 'True
RecordsetType = 1 'Dynaset
RecordSource = "SELECT id,isbn,bookname,author,bms,bmn,jg,fbl,bjh,class FROM 预采数据 WHERE fbl>0 ORDER BY fbl,jg"
Top = 0
Visible = 0 'False
Width = 2415
End
Begin VB.Label Label4
Caption = "金额："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7560
TabIndex = 4
Top = 120
Width = 975
End
Begin VB.Label Label3
Caption = "册数："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5640
TabIndex = 3
Top = 120
Width = 1095
End
Begin VB.Label Label2
Caption = "种数："
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3480
TabIndex = 2
Top = 120
Width = 1095
End
Begin VB.Label Label1
Caption = "您选择的图书如下："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 1
Top = 120
Width = 2775
End
End
Attribute VB_Name = "dgoutput1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_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
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 预采数据 where fbl>0")
If rs.EOF Then
MsgBox "采购数据库为空,不能转换！"
Close #1
Kill (filenam1)
rs.Close
db.Close
Exit Sub
End If
rs.MoveLast
rs.MoveFirst
recount = rs.RecordCount
Do While Not rs.EOF
'读取字段值
jkzh = Str(rs.Fields("ID").Value)
sm = rs.Fields("bookname").Value
jg1 = Trim(Str(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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -