form1.frm

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

Adodc7.RecordSource = "qjdak"
Adodc7.Refresh
Adodc6.Recordset.MoveFirst
Dim i As Long
For i = 1 To Adodc6.Recordset.RecordCount
    Adodc7.Recordset.AddNew
    Adodc7.Recordset!sh = Trim(Adodc6.Recordset!sh)
    Adodc7.Recordset!bj = Trim(Adodc6.Recordset!bj)
    Adodc7.Recordset.Update
    Adodc6.Recordset.MoveNext
Next i
''''''''''''''''''''''''删除c:\dak\dkgf.html或c:\dak\xfsh.html
Adodc3.Recordset.MoveFirst
Do While Not Adodc3.Recordset.EOF
        If fso.FileExists("c:\dak\" & Trim(Adodc3.Recordset!dm) & "\dkgf.html") = True Then
            fso.DeleteFile ("c:\dak\" & Trim(Adodc3.Recordset!dm) & "\dkgf.html"), True
        End If
        If fso.FileExists("c:\dak\" & Trim(Adodc3.Recordset!dm) & "\dkxf.html") = True Then
            fso.DeleteFile ("c:\dak\" & Trim(Adodc3.Recordset!dm) & "\dkxf.html"), True
        End If
    Adodc3.Recordset.MoveNext
Loop
''''''''''''''''''''''''生成抵扣库中购方在档案库中不符的记录。
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.CommandTimeout = 0
cn1.Open
cn1.CommandTimeout = 0
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open "select *  from dkk where upper(rtrim(gfsh)) not in(select upper(rtrim(sh)) from qjdak where bj='0')", cn1, 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) & "\dkgf.html", True
    Adodc3.Recordset.MoveNext
Loop
'''''''''''''''''''''''''''生成抵扣库中销方在档案库中不符的记录。
Dim cn2 As ADODB.Connection
Set cn2 = New ADODB.Connection
cn2.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;User ID=sa;Data Source=qfgl"
cn2.CommandTimeout = 0
cn2.Open
cn2.CommandTimeout = 0
Dim rs1 As ADODB.Recordset
Set rs1 = New ADODB.Recordset
rs1.CursorLocation = adUseClient
rs1.Open "select *  from dkk where (upper(rtrim(xfsh)) not in(select upper(rtrim(sh)) from qjdak where bj='0')) and left(xfsh,2)='65'", cn2, 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) & "\dkxf.html", True
    Adodc3.Recordset.MoveNext
Loop
'''''''''''''''''''''''''''''''''''''' 完毕
Form1.MousePointer = 0
Text1.Visible = False
MsgBox ("文件生成完毕！！！")
rs.Close
rs1.Close
Set rs = Nothing
Set rs1 = Nothing
cn2.Close
cn1.Close
End Sub

Private Sub mnuhfcg_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
cm.CommandText = "delete from cgk "
cm.Execute
'cn.Close
Form1.Adodc2.Refresh
Dim cgwj(1 To 11) As String
Dim ml As Integer
Adodc3.Recordset.Requery
ml = Adodc3.Recordset.RecordCount
cgwj(11) = "js002000.txt"
cgwj(1) = "js002000-01.txt"
cgwj(2) = "js002000-02.txt"
cgwj(3) = "js002000-03.txt"
cgwj(4) = "js002000-04.txt"
cgwj(5) = "js002000-05.txt"
cgwj(6) = "js002000-06.txt"
cgwj(7) = "js002000-07.txt"
cgwj(8) = "js002000-08.txt"
cgwj(9) = "js002000-09.txt"
cgwj(10) = "js002000-10.txt"
On Error GoTo aa:
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
Dim sss As String
Dim ssss As String
ssss = Trim(Adodc4.Recordset!dqh)
Adodc3.Recordset.MoveFirst
For i = 1 To ml
    For x = 1 To 11
        If fso.FileExists("c:\gxk\" & Trim(Adodc3.Recordset!dm) & "\" & cgwj(x)) Then
                Set fil = fso.GetFile("c:\gxk\" & Trim(Adodc3.Recordset!dm) & "\" & cgwj(x))
                If Month(fil.DateCreated) <> Month(Date) Then
                    MsgBox ("c:\gxk\" & Trim(Adodc3.Recordset!dm) & "\" & cgwj(x) & "文件不是本月的，请更新拷贝！！")
                    Form1.MousePointer = 0
                    Text1.Visible = False
                    Exit Sub
                End If
                Set ts = fso.OpenTextFile("c:\gxk\" & Trim(Adodc3.Recordset!dm) & "\" & cgwj(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) & "\" & cgwj(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) & "\" & cgwj(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 reads As String
                reads = ""
                Dim k As Long
                For k = 3 To s
                        If k < 10 Then
                               Form1.Adodc2.Recordset.AddNew
                               reads = Trim(ts.Read(1))
                               If reads = "" Then
                                    ts.Skip (4)
                               Else
                                    ts.Skip (2)
                               End If
                               Form1.Adodc2.Recordset!fpdm = ts.Read(10)
                                ts.Skip (2)
                               Form1.Adodc2.Recordset!fph = ts.Read(8)
                                ts.Skip (2)
                               Form1.Adodc2.Recordset!gfsh = ts.Read(15)
                               sss = ts.Read(1)
                               If sss <> "~" Then
                                    Form1.Adodc2.Recordset!gfsh = ssss & "00000000000"
                                    ts.Skip (4)
                               Else
                                    ts.Skip (1)
                               End If
                               Form1.Adodc2.Recordset!xfsh = ts.Read(15)
                                ts.Skip (2)
                               Form1.Adodc2.Recordset!rq = ts.Read(8)
                                Form1.Adodc2.Recordset.Update
                        ElseIf k > 9 And k < 100 Then
                                Form1.Adodc2.Recordset.AddNew
                                reads = Trim(ts.Read(1))
                                If reads = "" Then
                                    ts.Skip (5)
                                Else
                                    ts.Skip (3)
                                End If
                                Form1.Adodc2.Recordset!fpdm = ts.Read(10)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!fph = ts.Read(8)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!gfsh = ts.Read(15)
                                sss = ts.Read(1)
                               If sss <> "~" Then
                                    Form1.Adodc2.Recordset!gfsh = ssss & "00000000000"
                                    ts.Skip (4)
                               Else
                                    ts.Skip (1)
                               End If
                                Form1.Adodc2.Recordset!xfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!rq = ts.Read(8)
                                Form1.Adodc2.Recordset.Update
                        ElseIf k > 99 And k < 1000 Then
                                Form1.Adodc2.Recordset.AddNew
                                reads = Trim(ts.Read(1))
                                If reads = "" Then
                                    ts.Skip (6)
                                Else
                                    ts.Skip (4)
                                End If
                                Form1.Adodc2.Recordset!fpdm = ts.Read(10)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!fph = ts.Read(8)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!gfsh = ts.Read(15)
                               sss = ts.Read(1)
                               If sss <> "~" Then
                                    Form1.Adodc2.Recordset!gfsh = ssss & "00000000000"
                                    ts.Skip (4)
                               Else
                                    ts.Skip (1)
                               End If
                                Form1.Adodc2.Recordset!xfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!rq = ts.Read(8)
                                Form1.Adodc2.Recordset.Update
                        ElseIf k > 999 And k < 10000 Then
                                Form1.Adodc2.Recordset.AddNew
                                reads = Trim(ts.Read(1))
                                If reads = "" Then
                                    ts.Skip (7)
                                Else
                                    ts.Skip (5)
                                End If
                                Form1.Adodc2.Recordset!fpdm = ts.Read(10)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!fph = ts.Read(8)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!gfsh = ts.Read(15)
                               sss = ts.Read(1)
                               If sss <> "~" Then
                                    Form1.Adodc2.Recordset!gfsh = ssss & "00000000000"
                                    ts.Skip (4)
                               Else
                                    ts.Skip (1)
                               End If
                                Form1.Adodc2.Recordset!xfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!rq = ts.Read(8)
                                Form1.Adodc2.Recordset.Update
                        ElseIf k > 9999 And k < 100000 Then
                                Form1.Adodc2.Recordset.AddNew
                                reads = Trim(ts.Read(1))
                                If reads = "" Then
                                    ts.Skip (8)
                                Else
                                    ts.Skip (6)
                                End If
                                Form1.Adodc2.Recordset!fpdm = ts.Read(10)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!fph = ts.Read(8)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!gfsh = ts.Read(15)
                               sss = ts.Read(1)
                               If sss <> "~" Then
                                    Form1.Adodc2.Recordset!gfsh = ssss & "00000000000"
                                    ts.Skip (4)
                               Else
                                    ts.Skip (1)
                               End If
                                Form1.Adodc2.Recordset!xfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!rq = ts.Read(8)
                                Form1.Adodc2.Recordset.Update
                        ElseIf k > 99999 And k < 1000000 Then
                                Form1.Adodc2.Recordset.AddNew
                                reads = Trim(ts.Read(1))
                                If reads = "" Then
                                    ts.Skip (9)
                                Else
                                    ts.Skip (7)
                                End If
                                Form1.Adodc2.Recordset!fpdm = ts.Read(10)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!fph = ts.Read(8)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!gfsh = ts.Read(15)
                               sss = ts.Read(1)
                               If sss <> "~" Then
                                    Form1.Adodc2.Recordset!gfsh = ssss & "00000000000"
                                    ts.Skip (4)
                               Else
                                    ts.Skip (1)
                               End If
                                Form1.Adodc2.Recordset!xfsh = ts.Read(15)
                                ts.Skip (2)
                                Form1.Adodc2.Recordset!rq = ts.Read(8)
                                Form1.Adodc2.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 cgkqw"
cm1.Execute
cm1.CommandText = "insert into  cgkqw select fpdm,fph,gfsh,xfsh,rq from cgk where left(gfsh,4)<>'" & Trim(Adodc4.Recordset!dqh) & "'"
cm1.Execute
cm1.CommandText = "delete from cgk where left(gfsh,2)<>'65' or left(xfsh,2)<>'65'"
cm1.Execute
cn1.Close
''''''''''''''''''''''''''2002年8月20日升级，生成存放负数票的库。。
cm.CommandText = "if exists (select * from sysobjects where id=object_id('fsk') and sysstat&0xf=3)" _
& " drop table fsk"
cm.Execute
cm.CommandText = "create table fsk" _
& " (" _
& " fpdm char (10) NULL," _
& " fph  char (8) NULL," _
& " gfsh char (15) NULL," _
& " xfsh  char (15) NULL," _
& " rq char (8) NULL" _
& " )"
cm.Execute
cm.CommandText = "delete from fsk"
cm.Execute