⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 form1.frm

📁 税务机关增值税专用发票抵扣联和发票联比对系统
💻 FRM
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
cn.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=qfgl"
cn.Open
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open "select * from sheet1", cn, adOpenDynamic, adLockOptimistic
''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error GoTo bb
Dim cn1 As ADODB.Connection
Set cn1 = New ADODB.Connection
cn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=C:\dak\db1.mdb"
cn1.Open
Dim cm1 As ADODB.Command
Set cm1 = New ADODB.Command
cm1.ActiveConnection = cn1
cm1.CommandType = adCmdText
cm1.CommandTimeout = 0
cm1.CommandText = "delete from dak"
cm1.Execute
Dim rs1 As ADODB.Recordset
Set rs1 = New ADODB.Recordset
rs1.CursorLocation = adUseClient
rs1.Open "select * from dak", cn1, adOpenDynamic, adLockOptimistic
''''''''''''''''''''''''''''''''''''
Dim shs As Long
rs.MoveFirst
rs.MoveLast
shs = rs.RecordCount
rs.MoveFirst
Dim cz As Long
For cz = 1 To shs
    rs1.AddNew
    rs1!sh = rs!sh
    rs1!bj = rs!bj
    rs1.Update
    rs.MoveNext
Next
MsgBox ("档案库导入完毕！！！！")
Exit Sub
aa:
    MsgBox ("存放档案信息的表sheet1不存在")
    cn.Close
    Exit Sub
bb:
    MsgBox ("2001年12月软件升级后，c:\dak\db1库不存在！！！")
    cn.Close
    Set rs = Nothing
    Exit Sub
End Sub

Private Sub mnubdsh_Click()
Dim s As String
Dim i As Integer
Dim str As String
If Adodc4.Recordset.EOF Then
    str = "0"
Else
    str = Adodc4.Recordset!dqh
End If
s = InputBox("请输入本地前四位号码,现在地区税号为" & str)
If s = "" Then
    Exit Sub
End If
If Not Len(s) = 4 Then
    MsgBox ("地区号应为四位！！")
    Exit Sub
End If
If Left(s, 2) <> "65" Then
    MsgBox ("非法用户！！")
    Exit Sub
End If
If Adodc4.Recordset.EOF Then
Adodc4.Recordset.AddNew
Adodc4.Recordset!dqh = s
Else
Adodc4.Recordset!dqh = s
End If
Adodc4.Recordset.Update
End Sub

Private Sub mnudy_Click()

End Sub

Private Sub mnucfp_Click()
Form1.MousePointer = 3
Text1.Visible = True
Text1.ForeColor = &HFF0000
Text1.Text = "正在查询重复数据,请等待。。。"
Text1.Refresh
''''''''''''''
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=qfgl"
cn.Open
Dim cm As ADODB.Command
Set cm = New ADODB.Command
cm.ActiveConnection = cn
cm.CommandType = adCmdText
'''''''''''''''''''''''''''''''''''2001年12月18日升级
cm.CommandText = "select fpdm,fph,fpdm+fph as xj,gfsh,xfsh,rq into zjdkk from dkk"
cm.Execute
cm.CommandText = "insert into zjdkk select fpdm,fph,fpdm+fph as xj,gfsh,xfsh,rq from sydkk"
cm.Execute
''''''''''''''''''''''''''''''''''''''''
'cm.CommandText = "insert into dkkls (fpdm,fph,xj,gfsh,xfsh,rq) values('6500001140','00016046','650000114000016046','650103222','65010311','11')"
'cm.Execute
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open "select fpdm,fph,gfsh,xfsh,rq from zjdkk where xj in(select xj from zjdkk group by xj having count(*)>1)", cn, adOpenDynamic, adLockOptimistic
''''''''''''''''删除上月在c:\dkk\各区县文件cfp.html
Adodc3.Recordset.MoveFirst
Do While Not Adodc3.Recordset.EOF
        If fso.FileExists("c:\dkk\" & Trim(Adodc3.Recordset!dm) & "\cfp.html") = True Then
            fso.DeleteFile ("c:\dkk\" & Trim(Adodc3.Recordset!dm) & "\cfp.html"), True
        End If
    Adodc3.Recordset.MoveNext
Loop
'''''''''''''''''生成重复票文件
If rs.RecordCount = 0 Then
    Form1.MousePointer = 0
    Text1.Visible = False
    cm.CommandText = "drop table zjdkk"
    cm.Execute
    rs.Close
    Set rs = Nothing
    cn.Close
    MsgBox ("没有重复记录！！！！！！")
    Exit Sub
End If
Adodc3.Recordset.MoveFirst
Do While Not Adodc3.Recordset.EOF
    rs.Filter = "gfsh like '" & Trim(Adodc4.Recordset!dqh) & Trim(Adodc3.Recordset!hm) & "%'"
    Set drp4.DataSource = rs
    drp4.ExportReport rptKeyHTML, "c:\dkk\" & Trim(Adodc3.Recordset!dm) & "\cfp.html", True
    Adodc3.Recordset.MoveNext
Loop
Form1.MousePointer = 0
Text1.Visible = False
MsgBox ("文件生成完毕！！")
cm.CommandText = "drop table  zjdkk"
cm.Execute
rs.Close
Set rs = Nothing
cn.Close
End Sub

Private Sub mnucjdw_Click()
Load Form5
Form5.Show
End Sub

Private Sub mnuczy_Click()
Load Form3
Form3.Show
End Sub

Private Sub mnudqwh_Click()
Load Form7
Form7.Show 1
End Sub

Private Sub mnudak_Click()
Form7.Show 1
End Sub

Private Sub mnudawj_Click()
Adodc5.Refresh
Form1.MousePointer = 3
Text1.Visible = True
Text1.ForeColor = &HFF0000
Text1.Text = "正在生成档案不符文件,请等待。。。"
Text1.Refresh
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=qfgl"
cn.Open
cn.CommandTimeout = 0
Dim cm As ADODB.Command
Set cm = New ADODB.Command
cm.CommandTimeout = 0
cm.ActiveConnection = cn
cm.CommandType = adCmdText
cm.CommandText = "delete from sheet1 where bj='1'"
cm.Execute
cm.CommandText = "delete from dkkqw where upper(gfsh) in (select upper(sh) from sheet1)"
cm.Execute
cm.CommandText = "delete from cgkqw where upper(xfsh) in (select upper(sh) from sheet1)"
cm.Execute
cm.CommandText = "delete from dkk1"
cm.Execute
cm.CommandText = "delete from cgk1"
cm.Execute
cm.CommandText = "insert into dkk1 select fpdm,fph,gfsh,xfsh,rq from dkk where left(gfsh,4)='" & Trim(Adodc4.Recordset!dqh) & "'" & " and" & " left(xfsh,4)='" & Trim(Adodc4.Recordset!dqh) & "'"
cm.Execute
cm.CommandText = "insert into cgk1 select fpdm,fph,gfsh,xfsh,rq from cgk where left(gfsh,4)='" & Trim(Adodc4.Recordset!dqh) & "'" & " and" & " left(xfsh,4)='" & Trim(Adodc4.Recordset!dqh) & "'"
cm.Execute
cm.CommandText = "delete from dkk1 where upper(gfsh) in (select upper(sh) from sheet1) and upper(xfsh) in (select upper(sh) from sheet1)"
cm.Execute
cm.CommandText = "delete from cgk1 where upper(gfsh) in (select upper(sh) from sheet1) and upper(xfsh) in (select upper(sh) from sheet1)"
cm.Execute
cm.CommandText = "insert into dkk1 select fpdm,fph,gfsh,xfsh,rq from cgk1"
cm.Execute
cm.CommandText = "select fpdm,fph,gfsh,xfsh,rq into cgklx from cgkqw"
cm.Execute
cm.CommandText = "insert into cgklx select fpdm,fph,gfsh,xfsh,rq from dkk1 where upper(xfsh)  not in (select upper(sh) from sheet1)"
cm.Execute
cm.CommandText = "select fpdm,fph,gfsh,xfsh,rq into dkklx from dkkqw"
cm.Execute
cm.CommandText = "insert into dkklx select fpdm,fph,gfsh,xfsh,rq from dkk1 where upper(gfsh)  not in (select upper(sh) from sheet1)"
cm.Execute
cm.CommandText = "delete from dkklx where right(gfsh,11)='00000000000'"
cm.Execute
Adodc3.Recordset.MoveFirst
Do While Not Adodc3.Recordset.EOF
        If fso.FileExists("c:\dak\" & Trim(Adodc3.Recordset!dm) & "\dkk.html") = True Then
            fso.DeleteFile ("c:\dak\" & Trim(Adodc3.Recordset!dm) & "\dkk.html"), True
        End If
        If fso.FileExists("c:\dak\" & Trim(Adodc3.Recordset!dm) & "\cgk.html") = True Then
            fso.DeleteFile ("c:\dak\" & Trim(Adodc3.Recordset!dm) & "\cgk.html"), True
        End If
    Adodc3.Recordset.MoveNext
Loop
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open "select fpdm,fph,gfsh,xfsh,rq  from dkklx order by gfsh", cn, adOpenDynamic, adLockOptimistic
Adodc3.Recordset.MoveFirst
Do While Not Adodc3.Recordset.EOF
    rs.Filter = "gfsh like '" & Trim(Adodc4.Recordset!dqh) & Trim(Adodc3.Recordset!hm) & "%'"
    Set drp3.DataSource = rs
    drp3.ExportReport rptKeyHTML, "c:\dak\" & Trim(Adodc3.Recordset!dm) & "\dkk.html", True
    Adodc3.Recordset.MoveNext
Loop
Dim rs1 As ADODB.Recordset
Set rs1 = New ADODB.Recordset
rs1.CursorLocation = adUseClient
rs1.Open "select fpdm,fph,gfsh,xfsh,rq  from cgklx order by xfsh", cn, adOpenDynamic, adLockOptimistic
Adodc3.Recordset.MoveFirst
Do While Not Adodc3.Recordset.EOF
    rs1.Filter = "xfsh like '" & Trim(Adodc4.Recordset!dqh) & Trim(Adodc3.Recordset!hm) & "%'"
    Set drp3.DataSource = rs1
    drp3.ExportReport rptKeyHTML, "c:\dak\" & Trim(Adodc3.Recordset!dm) & "\cgk.html", True
    Adodc3.Recordset.MoveNext
Loop
Form1.MousePointer = 0
Text1.Visible = False
cm.CommandText = "drop table dkklx"
cm.Execute
cm.CommandText = "drop table cgklx"
cm.Execute
MsgBox ("文件生成完毕！！")
rs.Close
rs1.Close
Set rs = Nothing
Set rs1 = Nothing
cn.Close
End Sub

Private Sub mnudcdk_Click()
Form1.MousePointer = 3
Text1.Visible = True
Text1.ForeColor = &HFF0000
Text1.Text = "正在导出数据,请等待。。。"
Text1.Refresh
On Error GoTo aa
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=qfgl"
cn.CommandTimeout = 0
cn.Open
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open "select * from sheet1", cn, adOpenDynamic, adLockOptimistic
''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error GoTo bb
Dim cn1 As ADODB.Connection
Set cn1 = New ADODB.Connection
cn1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=C:\dak\db1.mdb"
cn1.CommandTimeout = 0
cn1.Open
Dim cm1 As ADODB.Command
Set cm1 = New ADODB.Command
cm1.ActiveConnection = cn1
cm1.CommandType = adCmdText
cm1.CommandTimeout = 0
cm1.CommandText = "delete from dak"
cm1.Execute
Dim rs1 As ADODB.Recordset
Set rs1 = New ADODB.Recordset
rs1.CursorLocation = adUseClient
rs1.Open "select * from dak", cn1, adOpenDynamic, adLockOptimistic
''''''''''''''''''''''''''''''''''''
Dim shs As Long
rs.MoveFirst
rs.MoveLast
shs = rs.RecordCount
rs.MoveFirst
Dim cz As Long
For cz = 1 To shs
    rs1.AddNew
    rs1!sh = rs!sh
    rs1!bj = rs!bj
    rs1.Update
    rs.MoveNext
Next
Form1.MousePointer = 0
Text1.Visible = False
MsgBox ("档案库导入完毕！！！！")
Exit Sub
aa:
    Form1.MousePointer = 0
    Text1.Visible = False
    MsgBox ("存放档案信息的表sheet1不存在")
    cn.Close
    Exit Sub
bb:
    Form1.MousePointer = 0
    Text1.Visible = False
    MsgBox ("2001年12月软件升级后，c:\dak\db1库不存在！！！")
    cn.Close
    Set rs = Nothing
    Exit Sub
End Sub

Private Sub mnudkdf_Click()
Form1.MousePointer = 3
Text1.Visible = True
Text1.ForeColor = &HFF0000
Text1.Text = "正在查询数据,请等待。。。"
Text1.Refresh
''''''''''''''生成存放由区局下发的档案数据库
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=qfgl"
cn.Open
Dim cm As ADODB.Command
Set cm = New ADODB.Command
cm.ActiveConnection = cn
cm.CommandType = adCmdText
cm.CommandText = "if exists (select * from sysobjects where id=object_id('qjdak') and sysstat&0xf=3)" _
& " drop table qjdak"
cm.Execute
cm.CommandText = "create table qjdak" _
& " (" _
& " sh char (15) NULL," _
& " bj  char (2) NULL" _
& " )"
cm.Execute
cn.Close
''''''''''''''''''''''将区局档案数据导入SQL数据库qjdak中
Adodc6.Refresh
Adodc7.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=qfgl"
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -