修改后代码

Private Sub GenerateTaxFileXml(ByRef iTaxYr As Short)  
        On Error GoTo erhd  
        Dim sFileName As String  
        Dim oFileSys As Scripting.FileSystemObject  
        Dim xmlDoc As MSXML2.DOMDocument  
        Dim Root As MSXML2.IXMLDOMElement  
 
        Dim oTextStream As Scripting.TextStream  
 
        Dim oSQL As ClsMySQL  
        'Dim rsRv As ADODB.Recordset  
        Dim sBuffer As String  
        Dim sBufferHeader As String  
 
        Dim sEmpyrTaxFIleNo As String  
        Dim sEmpyrNm As String  
        Dim sDesgn As String  
        Dim lRecordCount As Integer  
        Dim cTotAmt As Decimal  
        Dim lBtNo As Integer  
        Dim sSubDte As String  
        Dim sMsg As String  
 
        oSQL = New ClsMySQL  
 
        sFileName = GetExportDir() & VB6.Format(iTaxYr, "0000") & sTaxFile  
        oFileSys = New Scripting.FileSystemObject  
 
  'delete old tax file  
       If oFileSys.FileExists(sFileName) Then  
           oFileSys.DeleteFile(sFileName)  
       End If
      
        '生成一个XML DOMDocument对象  
        xmlDoc = New MSXML2.DOMDocument  
 
        '生成根节点并把它设置为文件的根  
        Root = xmlDoc.createElement("IR56B")  
        xmlDoc.documentElement = Root  
        '在节点上添加多个属性  
        Call Root.setAttribute("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance")  
        Call Root.setAttribute("xmlns", "http://www.kingdee.com/ReK3Inventory")  
       
       
         Using gConAPCA As New OleDbConnection(gStrAPCA)  
            oSQL.ReSet_Renamed()  
            oSQL.SqlType = ClsMySQL.StatmentType.TYPE_SELECT  
            oSQL.AddTable("TBL_APCA_FST_PTY_INFO")  
            oSQL.AddFields("TAX_FL_NO", "NM", "DESGN")  
 
            gReader = QueryByReader(gConAPCA, oSQL.SQL)  
 
            If gReader.Read Then  
                sEmpyrTaxFIleNo = Null2Str(gReader("TAX_FL_NO"))  
                sEmpyrNm = Null2Str(gReader("NM"))  
                sDesgn = Null2Str(gReader("DESGN"))  
 
            End If  
            gReader.Close()  
 
            oSQL.ReSet_Renamed()  
            oSQL.AddTable("TBL_APCA_TAX_REPORT")  
            oSQL.AddSimpleFuncField("COUNT", , , "REC_COUNT")  
            oSQL.AddSimpleFuncField("SUM", "TOT_INCOME", , "TOT")  
            oSQL.AddFields("BT_NO", "SUB_DTE")  
            oSQL.AddGroupBy("BT_NO")  
            oSQL.AddGroupBy("SUB_DTE")  
 
            gReader = QueryByReader(gConAPCA, oSQL.SQL)  
 
            If gReader.Read Then  
                lRecordCount = Null2Zero(gReader("REC_COUNT"))  
                cTotAmt = Null2Zero(gReader("TOT"))  
                lBtNo = CInt(Null2Str(gReader("BT_NO")))  
                sSubDte = VB6.Format(gReader("SUB_DTE").ToString, "YYYYMMDD")  
            End If  
            gReader.Close() 
       
       
       
       
        '添加二级节点
        Dim Section As MSXML2.IXMLDOMElement
        Section=xmlDoc.createElement("Section")
        Section.text=sEmpyrTaxFIleNo
        xmlDoc.appendChild Section
       
        Dim Section As MSXML2.IXMLDOMElement
        ERN=xmlDoc.createElement("ERN")       
        ERN.text=lBtNo
        xmlDoc.appendChild ERN
       
        ' and so on
      
      
        Dim Employee As MSXML2.IXMLDOMElement
        xmlDoc.appendChild Employee
        '添加Employee三级节点
       
 
 
 
 
        '-------------以下不用------------------------  

 
        oTextStream = oFileSys.OpenTextFile(sFileName, Scripting.IOMode.ForWriting, True)  
       
 
            sBuffer = FillStringWithSpaceRight(VB.Left(sEmpyrTaxFIleNo, 3), 3)  
            sBuffer = sBuffer & FillStringWithSpaceRight(VB.Right(sEmpyrTaxFIleNo, 8), 8)  'Section 
            sBuffer = sBuffer & FillStringWithSpaceRight(CStr(iTaxYr), 4)  'YrErReturn 
            sBuffer = sBuffer & FillStringWithSpaceRight(sSubDte, 8)   'SubDate
            sBuffer = sBuffer & FillStringWithZero(CStr(lBtNo), 5)   'ERN
            sBuffer = sBuffer & New String("0", 6)  
            sBuffer = sBuffer & Space(9)  
            sBuffer = sBuffer & FillStringWithSpaceRight(sEmpyrNm, 70)    'ErName
            sBuffer = sBuffer & FillStringWithSpaceRight(sDesgn, 25)   'Designation
            sBuffer = sBuffer & FillStringWithZero(CStr(lRecordCount), 5)   'NoRecordBatch
            sBuffer = sBuffer & FillStringWithZero(CStr(cTotAmt), 11)   'TotIncomeBatch
            sBuffer = sBuffer & Space(1480)  
            oTextStream.WriteLine(sBuffer)  
  '--------以下在用----
            oSQL.ReSet_Renamed()  
            oSQL.SqlType = ClsMySQL.StatmentType.TYPE_SELECT  
            oSQL.AddTable("TBL_APCA_TAX_REPORT")  
 
            sBufferHeader = FillStringWithSpaceRight(VB.Left(sEmpyrTaxFIleNo, 3), 3)  
            sBufferHeader = sBufferHeader & FillStringWithSpaceRight(VB.Right(sEmpyrTaxFIleNo, 8), 8)  
            sBufferHeader = sBufferHeader & FillStringWithSpaceRight(CStr(iTaxYr), 4)  
            sBufferHeader = sBufferHeader & FillStringWithSpaceRight(sSubDte, 8)  
            sBufferHeader = sBufferHeader & FillStringWithZero(CStr(lBtNo), 5)  
 
 
            gReader = QueryByReader(gConAPCA, oSQL.SQL)  
           
            Do While gReader.Read    
                sEmpyrTaxFIleNo = Null2Str(gReader("TAX_FL_NO"))  
                sEmpyrNm = Null2Str(gReader("NM"))  
                sDesgn = Null2Str(gReader("DESGN")) 
             
            Dim SHEET_NO As  String
            Dim HK_ID As  String
            Dim STUS As  String
            Dim S_NM As  String
            Dim NM As  String
            Dim C_NM As  String
           
           SHEET_NO = Null2Zero(gReader("REC_COUNT"))
           HK_ID = Null2Zero(gReader("HK_ID"))
           STUS = Null2Zero(gReader("STUS"))
           S_NM = Null2Zero(gReader("S_NM"))
           NM = Null2Zero(gReader("NM"))
           C_NM = Null2Zero(gReader("C_NM"))   
               
           Dim SHEET_NO As MSXML2.IXMLDOMElement
        SHEET_NO=xmlDoc.createElement("SHEET_NO")
        SHEET_NO.text=SHEET_NO
        Employee.appendChild SHEET_NO    
                   
          Dim HK_ID As MSXML2.IXMLDOMElement
        HK_ID=xmlDoc.createElement("HK_ID")
        HK_ID.text=HK_ID
        Employee.appendChild HK_ID
       
        Dim STUS As MSXML2.IXMLDOMElement
        STUS=xmlDoc.createElement("STUS")
        STUS.text=STUS
        Employee.appendChild STUS
       
        Dim S_NM As MSXML2.IXMLDOMElement
        S_NM=xmlDoc.createElement("S_NM")
        S_NM.text=S_NM
        Employee.appendChild S_NM
       
        Dim NM As MSXML2.IXMLDOMElement
        NM=xmlDoc.createElement("NM")
        NM.text=NM
        Employee.appendChild NM
       
        Dim C_NM As MSXML2.IXMLDOMElement
        C_NM=xmlDoc.createElement("C_NM")
        C_NM.text=C_NM
        Employee.appendChild C_NM
       
           Loop     
  '---以下不用----
            
 
                sBuffer = sBufferHeader & FillStringWithZero(CStr(gReader("SHEET_NO").ToString), 6)  
                sBuffer = sBuffer & FillStringWithSpaceLeft(Null2Str(gReader("HK_ID")), 9)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("STUS")), 1)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("S_NM")), 20)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("NM")), 55)  
                sBuffer = sBuffer & FillChiStringWithSpaceRight(Null2Str(gReader("C_NM")), 50)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("GENDER")), 1)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("M_STUS")), 1)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PASPT_NO")), 20)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PASPT_ISSUE_BY")), 20)   '??
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_NM")), 50)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_HKID")), 9)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_PASPT_NO")), 20)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("SPO_PASPT_ISSUE_BY")), 20)  '??
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_ADDR")), 90)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("AR_CDE")), 1)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("CORR_ADDR")), 60)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("CAPCTY")), 40)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRIN_EMPYR")), 30)  
                sBuffer = sBuffer & VB6.Format(gReader("JOIN_DTE").ToString, "YYYYMMDD")  
                sBuffer = sBuffer & VB6.Format(gReader("CESS_DTE").ToString, "YYYYMMDD")  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_SLRY")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("SLRY")), 9)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_LEV_PAY")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("LEV_PAY")), 9)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_DIR_FEE")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("DIR_FEE")), 9)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_COMM")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("COMM")), 9)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_BNS")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("BNS")), 9)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_BACK_PAY")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("BACK_PAY")), 9)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_RETR_SCHM_PMNT")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RETR_SCHM_PMNT")), 9)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_SLRY_TAX_EMPYR")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("SLRY_TAX_EMPYR")), 9)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_EDUC_BNF")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("EDUC_BNF")), 9)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_SHR_OPT_GAIN")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("SHR_OPT_GAIN")), 9) 
 
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_NATURE1")), 35)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_PRD1")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RWD_AMT1")), 9)  
 
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_NATURE2")), 35)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_PRD2")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RWD_AMT2")), 9)  
 
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_NATURE3")), 35)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RWD_PRD3")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RWD_AMT3")), 9)  
 
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_PNSN")), 19)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("PNSN")), 9)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("TOT_INCOME")), 9)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_IND")), 1)  
 
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_ADDR_1")), 110)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_NATURE_1")), 19)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_R_1")), 26)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_1")), 7)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYE_1")), 7)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_RFND_EMPYE_1")), 7)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_EMPYE_1")), 7)  
 
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_ADDR_2")), 110)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("R_NATURE_2")), 19)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("PRD_R_2")), 26)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_2")), 7)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYE_2")), 7)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_RFND_EMPYE_2")), 7)  
                sBuffer = sBuffer & FillStringWithZero(Null2Str(gReader("RENT_EMPYR_EMPYE_2")), 7)  
 
 
                If gReader("OSEA_AMT").Equals(DBNull.Value) And gReader("OSEA_ADDR").Equals(DBNull.Value) And gReader("OSEA_NM").Equals(DBNull.Value) Then  
                    sBuffer = sBuffer & "0" 
                Else  
                    sBuffer = sBuffer & "1" 
                End If  
 
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("OSEA_AMT")), 20)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("OSEA_NM")), 60)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("OSEA_ADDR")), 60)  
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("EMPYE_TAX_FL_NO")), 13)   '?
                sBuffer = sBuffer & FillStringWithSpaceRight(Null2Str(gReader("RMK")), 60)  
 
                oTextStream.WriteLine(sBuffer)  
                'rsRv.MoveNext()  
            Loop  
            '----------------以上不用----
            gReader.Close()  
 
            'End of file  
         '   oTextStream.Write(Chr(26))  
 
          '  oTextStream.Close()  
 
            oSQL.ReSet_Renamed()  
            oSQL.SqlType = ClsMySQL.StatmentType.TYPE_INSERT  
            oSQL.AddTable("TBL_APCA_AUD_LOG")  
 
            oSQL.AddField("USR")  
            oSQL.AddValue(sUserID)  
 
            oSQL.AddField("ACT")  
            oSQL.AddValue("S")  
 
            oSQL.AddField("LOG_TM")  
            oSQL.AddValue(VB6.Format(Today, "dd MMM YYYY") & " " & TimeOfDay)  
 
            oSQL.AddField("DESC")  
 
            sMsg = FormatMsg(My.Resources.str19011, CStr(iTaxYr), oFileSys.GetAbsolutePathName(sFileName))  
            oSQL.AddValue(sMsg)  
            'OpenRs(oSQL.SQL)  
 
            Call ExeNonQuery(gConAPCA, oSQL.SQL)  
 
 
            ShowInfo(sMsg)  
 
 
            '直接保存成文件即可  
            'xmlDoc.save(sFileName)  
 
            '调用IE浏览器打开xml文件  
            ShellExecute(Me.Handle.ToInt32, "explore", oFileSys.GetParentFolderName(sFileName) & vbNullChar, "", "", modShell.enuShowWindow.SW_SHOW)  
 
            oTextStream = Nothing  
            oFileSys = Nothing  
            'rsRv = Nothing  
            oSQL = Nothing  
        End Using  
 
        Exit Sub  
erhd:  
        oTextStream = Nothing  
        oFileSys = Nothing  
        'rsRv = Nothing  
        oSQL = Nothing  
        MyErrorRaise(Err.Description)  
    End Sub