form1.frm

税务机关增值税专用发票抵扣联和发票联比对系统

cm.CommandText = "insert into fsk select fpdm,fph,gfsh,xfsh,rq from cgk where right(gfsh,11)='" & "00000000000" & "'"
cm.Execute
cn.Close
'''''''''''''''''''''''''''''''''''''''''''
Form1.MousePointer = 0
Text1.Visible = False
MsgBox ("存根数据导入完毕！！！")
Exit Sub
'''''''''''''''''''''''''''''''错误处理
aa:
Form1.MousePointer = 0
Text1.Visible = False
MsgBox (Trim(Adodc3.Recordset!mc) & "的js002000.txt 文件格式有误")
Exit Sub
bb:
Form1.MousePointer = 0
Text1.Visible = False
MsgBox ("windows程序有误")
Exit Sub
End Sub

Private Sub mnuhfdk_Click()
On Error GoTo bb:
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.ActiveConnection = cn
cm.CommandType = adCmdText
''''''''''''''''''''''''''''''''''''''2001年12月18日升级
cm.CommandText = "if not exists (select * from sysobjects where id=object_id('sydkk') and sysstat&0xf=3)" _
& " select * into sydkk from dkk"
cm.Execute
''''''''''''''''''''''''''''''''''''''
cm.CommandText = "delete from dkk "
cm.Execute
cn.Close
Form1.Adodc1.Refresh
Dim ml As Integer
Adodc3.Recordset.Requery
ml = Adodc3.Recordset.RecordCount
Dim dkwj(1 To 11) As String
dkwj(11) = "js002010.txt"
dkwj(1) = "js002010-01.txt"
dkwj(2) = "js002010-02.txt"
dkwj(3) = "js002010-03.txt"
dkwj(4) = "js002010-04.txt"
dkwj(5) = "js002010-05.txt"
dkwj(6) = "js002010-06.txt"
dkwj(7) = "js002010-07.txt"
dkwj(8) = "js002010-08.txt"
dkwj(9) = "js002010-09.txt"
dkwj(10) = "js002010-10.txt"
Dim ts As TextStream
Dim fil As File
Dim i As Integer
Dim x As Integer
Dim s As String
Dim s1 As String
Dim l As Integer
Dim lr As Integer
On Error GoTo aa:
Adodc3.Recordset.MoveFirst
For i = 1 To ml
    For x = 1 To 11
        If fso.FileExists("c:\gxk\" & Trim(Adodc3.Recordset!dm) & "\" & dkwj(x)) Then
                Set fil = fso.GetFile("c:\gxk\" & Trim(Adodc3.Recordset!dm) & "\" & dkwj(x))
                If Month(fil.DateCreated) <> Month(Date) Then
                    MsgBox ("c:\gxk\" & Trim(Adodc3.Recordset!dm) & "\" & dkwj(x) & "文件不是本月的，请更新拷贝！！")
                    Form1.MousePointer = 0
                    Text1.Visible = False
                    Exit Sub
                End If
                Set ts = fso.OpenTextFile("c:\gxk\" & Trim(Adodc3.Recordset!dm) & "\" & dkwj(x), ForReading, True, TristateUseDefault)
                ts.SkipLine
                ts.SkipLine
                ts.SkipLine
                ts.SkipLine
                ts.SkipLine
                s1 = ts.ReadLine
                lr = Len(s1)
                If lr = 12 Then
                    ts.Close
                    Set ts = fso.OpenTextFile("c:\gxk\" & Trim(Adodc3.Recordset!dm) & "\" & dkwj(x), ForReading, True, TristateUseDefault)
                    ts.SkipLine
                    ts.SkipLine
                    ts.SkipLine
                    ts.SkipLine
                    ts.SkipLine
                    ts.Skip (6)
                    s = ts.Read(6)
                    ts.SkipLine
                    Dim t As Integer
                    For t = 1 To 6
                            If Left(s, 1) = "0" Then
                                s = Right(s, 6 - t)
                            Else
                                s = s
                                Exit For
                            End If
                    Next t
                Else
                    ts.Close
                    Set ts = fso.OpenTextFile("c:\gxk\" & Trim(Adodc3.Recordset!dm) & "\" & dkwj(x), ForReading, True, TristateUseDefault)
                    ts.SkipLine
                    ts.SkipLine
                    ts.SkipLine
                    ts.SkipLine
                    ts.SkipLine
                    ts.Skip (6)
                    l = Len(s1) - 6
                    s = ts.Read(l)
                    ts.SkipLine
                End If
                Dim k As Long
                For k = 3 To s
                        If k < 10 Then
                               Form1.Adodc1.Recordset.AddNew
                                ts.Skip (6)
                               Form1.Adodc1.Recordset!fpdm = ts.Read(10)
                                ts.Skip (2)
                               Form1.Adodc1.Recordset!fph = ts.Read(8)
                                ts.Skip (2)
                               Form1.Adodc1.Recordset!gfsh = ts.Read(15)
                                ts.Skip (2)
                               Form1.Adodc1.Recordset!xfsh = ts.Read(15)
                                ts.Skip (2)
                               Form1.Adodc1.Recordset!rq = ts.Read(8)
                                Form1.Adodc1.Recordset.Update
                        ElseIf k > 9 And k < 100 Then
                                Form1.Adodc1.Recordset.AddNew
                                ts.Skip (7)
                                Form1.Adodc1.Recordset!fpdm = ts.Read(10)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!fph = ts.Read(8)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!gfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!xfsh = ts.Read(15)
                                   ts.Skip (2)
                                Form1.Adodc1.Recordset!rq = ts.Read(8)
                                Form1.Adodc1.Recordset.Update
                        ElseIf k > 99 And k < 1000 Then
                                Form1.Adodc1.Recordset.AddNew
                                ts.Skip (8)
                                Form1.Adodc1.Recordset!fpdm = ts.Read(10)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!fph = ts.Read(8)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!gfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!xfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!rq = ts.Read(8)
                                Form1.Adodc1.Recordset.Update
                        ElseIf k > 999 And k < 10000 Then
                                Form1.Adodc1.Recordset.AddNew
                                ts.Skip (9)
                                Form1.Adodc1.Recordset!fpdm = ts.Read(10)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!fph = ts.Read(8)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!gfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!xfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!rq = ts.Read(8)
                                Form1.Adodc1.Recordset.Update
                        ElseIf k > 9999 And k < 100000 Then
                                Form1.Adodc1.Recordset.AddNew
                                ts.Skip (10)
                                Form1.Adodc1.Recordset!fpdm = ts.Read(10)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!fph = ts.Read(8)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!gfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!xfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!rq = ts.Read(8)
                                Form1.Adodc1.Recordset.Update
                        ElseIf k > 99999 And k < 1000000 Then
                                Form1.Adodc1.Recordset.AddNew
                                ts.Skip (11)
                                Form1.Adodc1.Recordset!fpdm = ts.Read(10)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!fph = ts.Read(8)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!gfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!xfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc1.Recordset!rq = ts.Read(8)
                                Form1.Adodc1.Recordset.Update
                        End If
                    ts.SkipLine
                    Next k
           End If
    Next x
    Adodc3.Recordset.MoveNext
Next i
''''''''''''''''''''''''''''''''''''''文件导入完毕
Dim cn1 As ADODB.Connection
Set cn1 = New ADODB.Connection
cn1.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=qfgl"
cn1.Open
Dim cm1 As ADODB.Command
Set cm1 = New ADODB.Command
cm1.ActiveConnection = cn1
cm1.CommandType = adCmdText
cm1.CommandText = "delete from dkkqw"
cm1.Execute
cm1.CommandText = "insert into  dkkqw select fpdm,fph,gfsh,xfsh,rq from dkk where left(xfsh,4)<>'" & Trim(Adodc4.Recordset!dqh) & "'"
cm1.Execute
cm1.CommandText = "delete from dkk where left(gfsh,2)<>'65' or left(xfsh,2)<>'65'"
cm1.Execute
cn1.Close
'''''''''''''''''''''''''''''''
Form1.MousePointer = 0
Text1.Visible = False
MsgBox ("抵扣数据导入完毕！！！")
Exit Sub
''''''''''''''''''''''''''''''''''''错误处理
aa:
Form1.MousePointer = 0
Text1.Visible = False
MsgBox (Trim(Adodc3.Recordset!mc) & "的js002010.txt 文件格式有误")
Exit Sub
bb:
Form1.MousePointer = 0
Text1.Visible = False
MsgBox ("windows程序有误")
Exit Sub
End Sub

Private Sub mnukb_Click()
If fso.FileExists("a:\js002000.txt") Then
   fso.CopyFile "a:\js002000.txt", "c:\gxk\js002000.txt", False
ElseIf fso.FileExists("a:\js002010.txt") Then
   fso.CopyFile "a:\js002010.txt", "c:\gxk\js002010.txt", False
Else
   MsgBox ("没有所需数据，请插入软盘或软盘已损坏！！")
End If
End Sub

Private Sub mnuqc_Click()
'''''''''''''''''''''''''''''2001年12月18日升级
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.CommandTimeout = 0
cm.ActiveConnection = cn
cm.CommandType = adCmdText
cm.CommandText = "if not exists (select * from sysobjects where id=object_id('rq') and sysstat&0xf=3)" _
& " select rq  into rq from jlk" _
& " delete from rq" _
& " insert into rq(rq) values ('200112')"
cm.Execute
Dim rsrq As ADODB.Recordset
Set rsrq = New ADODB.Recordset
rsrq.CursorLocation = adUseClient
rsrq.Open "select * from rq", cn, adOpenDynamic, adLockOptimistic
rsrq.MoveFirst
rsrq.Find "rq='" & CStr(Year(Date)) & CStr(Month(Date)) & "'"
If rsrq.EOF = True Then
    Dim dkbj As Integer
    dkbj = MsgBox("本月抵扣联检查结果正确吗？", vbYesNo, "提示")
    If dkbj = 6 Then
        cm.CommandText = "select fpdm,fph,fpdm+fph as xj,gfsh,xfsh,rq into dkkls from dkk"
        cm.Execute
        cm.CommandText = "delete from sydkk "
        cm.Execute
        cm.CommandText = "insert into sydkk select fpdm,fph,gfsh,xfsh,rq from  dkkls  where xj not in(select xj from dkkls group by xj having count(*)>1)"
        cm.Execute
        cm.CommandText = "drop table dkkls"
        cm.Execute
        cm.CommandText = "insert into rq(rq) values('" & CStr(Year(Date)) & CStr(Month(Date)) & "')"
        cm.Execute
        Set rsrq = Nothing
        cn.Close
    Else
        MsgBox ("请检查抵扣联，将其更正！！！！")
        Set rsrq = Nothing
        cn.Close
        Exit Sub
    End If
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Adodc4.Recordset.EOF Then
    MsgBox ("您必须输入本地税号才能执行··")
    Exit Sub
End If
Dim ww As String
ww = Trim(Adodc4.Recordset!dqh)
Form1.MousePointer = 3
Text1.Visible = True
Text1.ForeColor = &HFF0000
Text1.Text = "正在比对删除数据,请等待。。。"
Text1.Refresh
Form1.Refresh
Dim cn1 As ADODB.Connection
Set cn1 = New ADODB.Connection
cn1.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=qfgl"
cn1.Open
Dim cm1 As ADODB.Command
Set cm1 = New ADODB.Command
cm1.CommandTimeout = 0
cm1.ActiveConnection = cn1
cm1.CommandType = adCmdText
Adodc5.Recordset.MoveFirst
Adodc5.Recordset.Find "rq='" & CStr(Year(Date)) & CStr(Month(Date)) & "'"
If Adodc5.Recordset.EOF Then
    Adodc5.Recordset.AddNew
    Adodc5.Recordset!rq = CStr(Year(Date)) & CStr(Month(Date))
    Adodc5.Recordset.Update
    cm1.CommandText = "delete from dkkcbak"
    cm1.Execute
    cm1.CommandText = "delete from cgkcbak"
    cm1.Execute
    cm1.CommandText = "insert into dkkcbak select fpdm,fph,xj1,gfsh,xfsh,rq from dkkc"
    cm1.Execute
    cm1.CommandText = "insert into cgkcbak select fpdm,fph,xj1,gfsh,xfsh,rq from cgkc"
    cm1.Execute
Else
    cm1.CommandText = "delete from dkkc"
    cm1.Execute
    cm1.CommandText = "delete from cgkc"
    cm1.Execute
    cm1.CommandText = "insert into dkkc select fpdm,fph,xj1,gfsh,xfsh,rq from dkkcbak"
    cm1.Execute
    cm1.CommandText = "insert into cgkc select fpdm,fph,xj1,gfsh,xfsh,rq from cgkcbak"
    cm1.Execute
End If
cm1.CommandText = "insert into dkkc select fpdm,fph,fpdm+fph as xj1,gfsh,xfsh,rq from dkk where left(gfsh,4)='" & ww & "'" & " and left(xfsh,4)='" & ww & "'"
cm1.Execute
cm1.CommandText = "insert into cgkc select fpdm,fph,fpdm+fph as xj1,gfsh,xfsh,rq from cgk where left(gfsh,4)='" & ww & "'" & " and left(xfsh,4)='" & ww & "'"
cm1.Execute
cm1.CommandText = "select distinct dkkc.fpdm+dkkc.fph as xj into  hj from dkkc,cgkc   where dkkc.fpdm=cgkc.fpdm and dkkc.fph=cgkc.fph"
cm1.Execute
cm1.CommandText = " delete from dkkc where xj1 in (select xj fro