'进度条
Dim pbr1 As Long, pbr2 As Long
pbr.Visible = True
pbr.Min = 1
If CDbl(txtcBillCode_To.Text) - CDbl(txtcBillCode_From.Text) > 100 Then
pbr.Max = CDbl(txtcBillCode_To.Text) - CDbl(txtcBillCode_From.Text)
pbr.Value = 1
pbr1 = 1
pbr2 = 1
Else
pbr.Max = 100
pbr.Value = 1
If CDbl(txtcBillCode_To.Text) - CDbl(txtcBillCode_From.Text) = 0 Then
pbr1 = 2
pbr2 = 100
Else
pbr1 = 1
pbr2 = 100 / (CDbl(txtcBillCode_To.Text) - CDbl(txtcBillCode_From.Text))
End If
End If
i_cBillCode = CDbl(txtcBillCode_From.Text)
iBillNum = 0
Do While i_cBillCode <= CDbl(txtcBillCode_To.Text)
If pbr1 > pbr.Max Then pbr1 = pbr.Max
pbr.Value = pbr1
pbr1 = pbr1 + pbr2
'//begin导出主表内容*********************
'发票号码
cBillCode = Right("000000000000" + Trim(Str(i_cBillCode)), Len(Trim(txtcBillCode_From.Text)))
'检测该发票号码是否存在
If ar_UFBill.State = adStateOpen Then ar_UFBill.Close
ar_UFBill.Open "select cSBVcode from salebillvouch where right(cSBVCode,8)='" & Trim(cBillCode) & "'"
'用友数据库中存在此发票号码
If ar_UFBill.RecordCount > 0 Then
iBillNum = iBillNum + 1
'商品行数,备注
ar_Tmp.Open " select sbv.cMemo as sbvMemo from SaleBillVouch as sbv,SalebillVouchs as sbvs " _
& " where right(cSBVCode,8)='" & Trim(cBillCode) & "' " _
& " and sbv.SBVID=sbvs.SBVID"
If ar_Tmp.RecordCount > 0 Then
cLinage = Trim(Str(ar_Tmp.RecordCount))
cMemo = Trim(ar_Tmp!sbvMemo) & ""
Else
cLinage = ""
cMemo = ""
End If
ar_Tmp.Close
'客户名称(50) 税号(15) 地址(40) 银行帐号(40)
ar_Tmp.Open " select cus.cCusName as CusName,cCusRegCode,cCusAddress,cCusAccount " _
& " from customer as cus,salebillvouch as sbv " _
& " where sbv.cCusCode=cus.cCusCode " _
& " and right(cSBVCode,8)='" & Trim(cBillCode) & "'"
If ar_Tmp.RecordCount > 0 Then
'客户名称
If Not (IsNull(ar_Tmp!CusName) Or ar_Tmp!CusName = "") Then
cCusName = Trim(ar_Tmp!CusName)
Else
cCusName = "客户名称"
End If
'税号
If Not (IsNull(ar_Tmp!cCusRegCode) Or ar_Tmp!cCusRegCode = "") Then
cCusRegCode = Trim(ar_Tmp!cCusRegCode)
Else
cCusRegCode = "123456789012345"
End If
'地址
If Not (IsNull(ar_Tmp!cCusAddress) Or ar_Tmp!cCusAddress = "") Then
cCusAddress = Trim(ar_Tmp!cCusAddress)
Else
cCusAddress = "客户地址"
End If
'银行账号
If Not (IsNull(ar_Tmp!cCusAccount) Or ar_Tmp!cCusAccount = "") Then
cCusAccount = Trim(ar_Tmp!cCusAccount)
Else
cCusAccount = "1234-5678"
End If
End If
ar_Tmp.Close
'\\begin导出子表内容**********************************
'货物名称(30) 计量单位(6) 规格(16) 数量(16.6) 金额(14.2) 税率(4.2) 商品类别(5) 折扣金额(14.2)
ar_Tmp.Open " select inv.cInvName as InvName,cInvM_Unit,cInvStd,iQuantity,iMoney," _
& " sbv.iTaxRate as TaxRate,iNatDisCount " _
& " from inventory as inv,salebillvouch as sbv,salebillvouchs as sbvs " _
& " where right(cSBVCode,8)='" & Trim(cBillCode) & "' and sbv.SBVID=sbvs.SBVID " _
& " and sbvs.cInvCode=inv.cInvCode"
If ar_Tmp.RecordCount > 0 Then
cSMCode = Trim(txtcSMCode.Text)
ar_Tmp.MoveLast
ar_Tmp.MoveFirst
Do While ar_Tmp.EOF = False
'货物名称
If Not (IsNull(ar_Tmp!InvName) Or ar_Tmp!InvName = "") Then
cInvName = Trim(ar_Tmp!InvName)
Else
cInvName = "货物名称"
End If
'计量单位
If Not (IsNull(ar_Tmp!cInvM_Unit) Or ar_Tmp!cInvM_Unit = "") Then
cInvM_Unit = Trim(ar_Tmp!cInvM_Unit)
Else
cInvM_Unit = "单位"
End If
'规格型号
If Not (IsNull(ar_Tmp!cInvStd) Or ar_Tmp!cInvStd = "") Then
cInvStd = Trim(ar_Tmp!cInvStd)
Else
cInvStd = "规格型号"
End If
'数量
If Not (IsNull(ar_Tmp!iQuantity) Or ar_Tmp!iQuantity = "") Then
cQuantity = Trim(Str(ar_Tmp!iQuantity))
Else
cQuantity = "0"
End If
'金额
If Not (IsNull(ar_Tmp!iMoney) Or ar_Tmp!iMoney = "") Then
cMoney = Trim(Str(ar_Tmp!iMoney))
Else
cMoney = "0"
End If
'税率
If Not (IsNull(ar_Tmp!TaxRate) Or ar_Tmp!TaxRate = "") Then
cTaxRate = Trim(Str(ar_Tmp!TaxRate / 100))
Else
cTaxRate = "0.17"
End If
'折扣金额
If Not (IsNull(ar_Tmp!iNatDisCount) Or ar_Tmp!iNatDisCount = "") Then
cNatDisCount = Trim(Str(ar_Tmp!iNatDisCount))
Else
cNatDisCount = "0"
End If
Print #1, Space(1) + cInvName + Space(2) + cInvM_Unit + Space(2) _
& cInvStd + Space(2) + cQuantity + Space(2) + cMoney + Space(2) _
& cTaxRate + Space(2) + cSMCode + Space(2) + cNatDisCount
ar_Tmp.MoveNext
Loop
End If
ar_Tmp.Close
End If
ar_UFBill.Close
i_cBillCode = i_cBillCode + 1
Loop
Close #1
pbr.Visible = False
If iBillNum = 0 Then
MsgBox "所选发票号码不存在,文本文件没有生成!", 48, "结果提示"
Call SelAllTxt(Me, "txtcBillCode_From")
lblufsoft.Visible = True
Exit Sub
Else
lblwjlj.Visible = True
lblwjlj2.Visible = True
MsgBox "有" + Trim(Str(iBillNum)) + "张发票成功地导出为文本文件,文件为c:\Nbufbill.txt!", 32, "结果提示"
End If
txtcBillCode_From.Text = ""
txtcBillCode_To.Text = ""
lblwjlj.Visible = False
lblwjlj2.Visible = False
lblufsoft.Visible = True
Exit Sub
Err_Rac:
MsgBox "检测失败!错误原因为:" & Err.Description, vbExclamation, "提示"
MousePointer = 0
Exit Sub
End Sub
Private Sub cmdout_Click()
Dim i_cBillCode As Long
Dim iBillNum As Integer '发票数量
Dim ar_Tmp As New ADODB.Recordset
On Error GoTo Err_Rac:
Dim ar_UFBill As New ADODB.Recordset
'//begin发票主表信息******************
Dim cBillCode As String '发票号码
Dim cLinage As String '商品行数
Dim cCusName As String '客户名称
Dim cCusRegCode As String '税号
Dim cCusAddress As String '地址
Dim cCusAccount As String '银行账号
Dim cMemo As String '备注
'//end发票主表信息*********************
'\\begin发票子表信息***********************
Dim cInvName As String '货物名称
Dim cInvM_Unit As String '计量单位
Dim cInvStd As String '规格型号
Dim cQuantity As String '数量
Dim cMoney As String '金额
Dim cTaxRate As String '税率
Dim cSMCode As String '商品类别(税目)
Dim cNatDisCount As String '折扣金额
'\\end发票子表信息**************************
'判断发票号码是否输入
If Trim(txtcBillCode_From.Text) = "" Then
MsgBox "请输入“起始发票号”!", 48, "提示"
txtcBillCode_From.SetFocus
Exit Sub
End If
If Trim(txtcBillCode_To.Text) = "" Then
MsgBox "请输入“截止发票号”!", 48, "提示"
txtcBillCode_To.SetFocus
Exit Sub
End If
'判断税目代码是否输入
If Trim(txtcSMCode.Text) = "" Then
MsgBox "请输入“税目代码”!", 48, "提示"
txtcSMCode.SetFocus
Exit Sub
End If
'判断起始发票号是否小于等于截止发票号
If CDbl(txtcBillCode_From.Text) > CDbl(txtcBillCode_To.Text) Then
MsgBox "发票起始号码不能大于发票截止号码,请重新输入!", 48, "错误提示"
Call SelAllTxt(Me, "txtcBillCode_From")
Exit Sub
End If
If Rac.State = adStateOpen Then Rac.Close
Rac.Open CnStr
With ar_Tmp
.ActiveConnection = Rac '定义数据连接对象
.CursorType = adOpenKeyset '定义游标类型
.LockType = adLockReadOnly '定义打开方式
End With
With ar_UFBill
.ActiveConnection = Rac '定义数据连接对象
.CursorType = adOpenKeyset '定义游标类型
.LockType = adLockReadOnly '定义打开方式
End With
'//begin开始导出************************************
'Open billout.txt For Output As 1
'Open billout.txt For Append As 1
'aa = SendKeys(enter)
'Shell ("c:\windows\notepad.exe")
lblufsoft.Visible = False
Open "c:\Nbufbill.txt" For Output As #1
'文本文件头
Dim title1, title2, title3, title4, title5, title6
title1 = "//适用于功能【 数据接口\开票数据传入】"
title2 = "// 销售单据传入文件(Yutou.TXT)"
title3 = "// 单据号(20) 商品行数(4) 客户名称(50) 税号(15) 地址(40) 银行帐号(40) 备注(70)"
title4 = "// 货物名称(30) 计量单位(6) 规格(16) 数量(16.6) 金额(14.2) 税率(4.2) 商品类别(5) 折扣金额(14.2)"
title5 = "// ..."
title6 = "// ..."
Print #1, title1
Print #1, Space(0)
Print #1, title2
Print #1, title3
Print #1, title4
Print #1, title5
Print #1, title6
Print #1, Space(0)
Print #1, Space(0)