vb xml

http://www.360doc.com/content/13/1026/11/14285739_324294674.shtml

 

 

 

 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

        '生成一个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")






        '-------------------------------------
        'Dim XmlWrite As System.Xml.XmlTextWriter = New System.Xml.XmlTextWriter(sFileName, System.Text.Encoding.UTF8)
        ' XmlWrite.WriteStartDocument() '开始一个文档，写下图第一行
        'XmlWrite.WriteStartElement("IR56B") '开始一个元素,根元素
        'XmlWrite.WriteAttributeString("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance") '元素属性
        'XmlWrite.WriteAttributeString("xsi:noNamespaceSchemaLocation", "ir56b.xsd") '元素属性
        'XmlWrite.WriteStartElement("Section") '开始一个元素book






        oTextStream = oFileSys.OpenTextFile(sFileName, Scripting.IOMode.ForWriting, True)
        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()

            sBuffer = FillStringWithSpaceRight(VB.Left(sEmpyrTaxFIleNo, 3), 3)
            sBuffer = sBuffer & FillStringWithSpaceRight(VB.Right(sEmpyrTaxFIleNo, 8), 8)
            sBuffer = sBuffer & FillStringWithSpaceRight(CStr(iTaxYr), 4)
            sBuffer = sBuffer & FillStringWithSpaceRight(sSubDte, 8)
            sBuffer = sBuffer & FillStringWithZero(CStr(lBtNo), 5)
            sBuffer = sBuffer & New String("0", 6)
            sBuffer = sBuffer & Space(9)
            sBuffer = sBuffer & FillStringWithSpaceRight(sEmpyrNm, 70)
            sBuffer = sBuffer & FillStringWithSpaceRight(sDesgn, 25)
            sBuffer = sBuffer & FillStringWithZero(CStr(lRecordCount), 5)
            sBuffer = sBuffer & FillStringWithZero(CStr(cTotAmt), 11)
            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

                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

 

 

 

------------------------

 

Dim oFso As New FileSystemObject
Dim oFile As Object
Dim xmlDoc As MSXML2.DOMDocument

 

    nowDate = CStr(Year(Date)) & CStr(Month(Date)) & CStr(Day(Date))
    ePath = expPath.Text + "/" + nowDate
     
    Set xmlDoc = New MSXML2.DOMDocument
    xmlDoc.validateOnParse = False
    xmlDoc.async = False
    
    Set oFso = CreateObject("scripting.filesystemobject")
    If oFso.FileExists(ePath + ".xml") Then
        oFso.DeleteFile ePath + ".xml"
    End If
    Set oFile = oFso.OpenTextFile(ePath + ".xml", 8, True) 

 

Dim str As String
    str = "select ajbh from gab_mala where ifexp is null or ifexp=''"
    oRs.Open str, oConn, 1, 1
    
    Do While Not oRs.EOF
    
        tempzdaj = "<zdaj:record ajbh='" + oRs("ajbh") + "'><ma><la>"
        oFile.WriteLine (tempzdaj)
        
        '基本信息
        str = "select xckybh,ladwdm,ladwxc,ajlb1,ajlb2,ajlb3,ajxz1,larq,swrs,ssrs,fxdz,fxdzxz,fxcs,fxbw,zwyw,dnayw,"
        str = str + "zjyw,xdhwyw,gj,gjhj,qthjwz,bjwp,zasjsx,zasjxx,fxzarscz,fxzarszz,zagj,qhdx,srcs,qrfs,jcfs,srfs,"
        str = str + "wzmj,tlfs,zasdtdms,aqms,zayy,lcfzyj,zazzhzbzcy,lxdh,xsjsfzr,gajgfzr,tbr,tbrq from gab_mala where ajbh='" & oRs("ajbh") & "'"
        oRsTemp.Open str, oConn, 1, 1
       
        Do While Not oRsTemp.EOF
            Set root = xmlDoc.createNode(1, "jbxx", "")
            Set temp = xmlDoc.appendChild(root)
            
            Set onode = xmlDoc.createNode("element", "rec", "")
            Set temp = root.appendChild(onode)
            
                For i = 0 To oRsTemp.Fields.Count - 1
                
                Set child = xmlDoc.createNode("element", oRsTemp.Fields(i).Name, "")
                  
                If Not IsNull(oRsTemp.Fields(i)) Then
                    If oRsTemp.Fields(i).Name = UCase("fxcs") Or oRsTemp.Fields(i).Name = UCase("fxbw") Or oRsTemp.Fields(i).Name = UCase("zagj") Or oRsTemp.Fields(i).Name = UCase("qhdx") Or oRsTemp.Fields(i).Name = UCase("srcs") Or oRsTemp.Fields(i).Name = UCase("qrfs") Or oRsTemp.Fields(i).Name = UCase("jcfs") Or oRsTemp.Fields(i).Name = UCase("srfs") Or oRsTemp.Fields(i).Name = UCase("wzmj") Or oRsTemp.Fields(i).Name = UCase("zayy") Then
                        childext = CL(oRsTemp.Fields(i))
                    Else.T
                        child.Text = oRsTemp.Fields(i)
                    End If
                Else
                    child.Text = ""
                End If
                  
                  Set temp = onode.appendChild(child)
                Next
                
                rstoxml = root.xml

            oFile.WriteLine (rstoxml)
            xmlDoc.removeChild (root)
       
            oRsTemp.MoveNext
        Loop
        oRsTemp.Close

'人员
        
        str = "select manid from caseman where caseno='" & oRs("ajbh") & "'"
        oRs1.Open str, oConn, 1, 1
        
        If oRs1.RecordCount > 0 Then
            Set root = xmlDoc.createNode(1, "xyry", "")
            Set temp = xmlDoc.appendChild(root)
        End If
        
        Do While Not oRs1.EOF
            str = "select ztrybh,name as xm,othername as bmhch,sex as xb,birthday as csrqsx,birthday as csrqxx,jzd as hjd,ABODEADDR as hjdxz,STATURE as sgsx,STATURE as sgxx,ACCENT as ky,BODYSHAPE as tmtz,FACESHAPE as tbbj,'' as qttz,SPEC as zc,CARDID as sfzh,'' as qtzjmc,'' as qtzjhm,'' as zp from smaninfo"
            str = str + " where manid='" & oRs1("manid") & "'"
            oRsTemp.Open str, oConn, 1, 1
            
            Do While Not oRsTemp.EOF
                
                
                Set onode = xmlDoc.createNode("element", "rec", "")
                Set temp = root.appendChild(onode)
                
                    For i = 0 To oRsTemp.Fields.Count - 1
                    
                    Set child = xmlDoc.createNode("element", oRsTemp.Fields(i).Name, "")
                      
                    If Not IsNull(oRsTemp.Fields(i)) Then
                        If oRsTemp.Fields(i).Name = UCase("ky") Or oRsTemp.Fields(i).Name = UCase("tmtz") Or oRsTemp.Fields(i).Name = UCase("tbbj") Or oRsTemp.Fields(i).Name = UCase("zc") Then
                            child.Text = CL(oRsTemp.Fields(i))
                        Else
                            If oRsTemp.Fields(i).Name = UCase("csrqsx") Or oRsTemp.Fields(i).Name = UCase("csrqxx") Then
                                child.Text = CLDate(oRsTemp.Fields(i))
                            Else
                                If oRsTemp.Fields(i).Name = UCase("ztrybh") Then
                                    child.Text = "T" + oRsTemp.Fields(i)
                                Else
                                    child.Text = oRsTemp.Fields(i)
                                End If
                            End If
                        End If
                    Else
                        child.Text = ""
                    End If
                      
                      Set temp = onode.appendChild(child)
                    Next
                                      
                oRsTemp.MoveNext
            Loop
            oRsTemp.Close
            
            oRs1.MoveNext
        Loop
        
        If oRs1.RecordCount > 0 Then
            rstoxml = root.xml
            oFile.WriteLine (rstoxml)
            xmlDoc.removeChild (root)
        End If
        
        oRs1.Close

        tempzdaj = "</la></ma></zdaj:record>"
        oFile.WriteLine (tempzdaj)
        oRs.MoveNext
        
    Loop
    
    oRs.Close

set oFso=Nothing

 

 

        '生成一个XML DOMDocument对象
        xmlDoc = New MSXML2.DOMDocument

        '生成根节点并把它设置为文件的根
        Root = xmlDoc.createElement("employees")
        xmlDoc.documentElement = Root
        '在节点上添加多个属性
        Call Root.setAttribute("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance")
        Call Root.setAttribute("xmlns", "http://www.kingdee.com/ReK3Inventory")

        '添加xml文件格式：换行+空格 (1级节点)

        Root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))



        '添加DataService节点

        Dim eleDataService As MSXML2.IXMLDOMElement

        eleDataService = xmlDoc.createElement("DataService")

        Root.appendChild(eleDataService)



        '添加xml文件格式：换行+空格+空格（2级节点）

        eleDataService.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))



        '添加 Name 属性

        eleDataService.setAttribute("Name", "zhuyl")



        '添加DataService节点的子节点 Ip

        Dim eleDataServiceIp As MSXML2.IXMLDOMElement

        eleDataServiceIp = xmlDoc.createElement("Ip")

        eleDataService.appendChild(eleDataServiceIp)



        '添加xml文件格式：换行+空格（1级节点），结束1级节点配置

        eleDataService.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))



        '添加xml文件格式：换行+空格+空格，结束根结点配置     

        Root.appendChild(xmlDoc.createTextNode(vbCrLf))


 
 
 
 
 
 
 
 
 
 
 
 --------------------
 
 '2、  读取xml



        adapterConfigFilePath = Me.maFileName & "AdapterConfig.xml"

        xmlDom = New DOMDocument50

        xmlDoc.async = False  '是否同步

        xmlDoc.load(adapterConfigFilePath)



        '如果文件存在，但大小为0字节，则删除该文件

        If (fso.FileExists(adapterConfigFilePath) = True) Then

            If (fso.GetFile(adapterConfigFilePath).Size = 0) Then

                fso.GetFile(adapterConfigFilePath).Delete()

            End If

        End If



        '检查AdapterConfig.xml文件是否存在：若存在，则读取文件的值，并显示在窗体上

        If (fso.FileExists(adapterConfigFilePath) = True) Then



            element = xmlDoc.selectSingleNode("//AdapterConfig")

            Me.txtAdapterName.Text = element.selectSingleNode("AdapterName").Text



            Dim strAdapterType As String

            strAdapterType = element.selectSingleNode("AdapterType").Text

            If (strAdapterType = "DataBase" Or strAdapterType = "") Then

                '单选按钮数据库 设置为被选中

                Me.optAdapterType1.Item(0).Value = True

            Else



                If (strAdapterType = "File") Then

                    Me.optAdapterType1.Item(1).Value = True

                ElseIf (strAdapterType = "Api") Then

                    Me.optAdapterType1.Item(2).Value = True

                ElseIf (strAdapterType = "SDE") Then

                    Me.optAdapterType1.Item(3).Value = True

                End If

            End If



            '应用，为应用列表赋值

            elePM = element.selectSingleNode("ApplicationParameter")

            If (Not (elePM Is Nothing)) Then

                paramList = element.selectNodes("ApplicationParameter")

                For i = 0 To paramList.length - 1

                    eleParam = paramList.Item(i)

                    Me.lstAppParameter.AddItem(eleParam.getAttribute("Name"))

                Next

            End If





            '3、  修改xml

            Dim fso As New FileSystemObject



            netConfigPath = frmMain.maFileName & "AdapterNetConfig.xml"

            xmlDom = New DOMDocument50

            xmlDoc.async = False  '是否同步

            xmlDoc.load(netConfigPath)



            '检查AdapterNetConfig.xml文件是否存在：若不存在，则创建；存在，则显示值到窗体上If (fso.FileExists(netConfigPath) = True) Then



            '必填项全部填写，保存修改的内容

            Root = xmlDoc.selectSingleNode("AdapterNetConfig")



            '为节点赋值

            Root.selectSingleNode("DataService/Ip").text = Me.txtAdapterReceiveIp.Text

            Root.selectSingleNode("DataService/Port").text = Me.txtAdapterReceivePort.Text

            Root.selectSingleNode("DataService/TimeOut").text = Me.txtAdapterReceiveTimeout.Text



            Root.selectSingleNode("CommandService/Ip").text = Me.txtCmdReceiveIp.Text

            Root.selectSingleNode("CommandService/Port").text = Me.txtCmdReceivePort.Text

            Root.selectSingleNode("CommandService/TimeOut").text = Me.txtCmdReceiveTimeout.Text



            Root.selectSingleNode("DataExchangeServer/Ip").text = Me.txtSendToServerIp.Text

            Root.selectSingleNode("DataExchangeServer/Port").text = Me.txtSendToServerPort.Text

            Root.selectSingleNode("DataExchangeServer/TimeOut").text = Me.txtSendToServerTimeout.Text



            xmlDoc.save(netConfigPath)

            MsgBox("保存成功！")

        End If





        '4、  xml文件格式化

        '获取AdapterConfig.xml所在路径--->maFileName

        adapterConfigFilePath = Me.maFileName & "AdapterConfig.xml"

        xmlDom = New DOMDocument50

        xmlDoc.async = False  '是否同步

        xmlDoc.load(adapterConfigFilePath)



        '如果文件存在，但大小为0字节，则删除该文件

        If (fso.FileExists(adapterConfigFilePath) = True) Then

            If (fso.GetFile(adapterConfigFilePath).Size = 0) Then

                fso.GetFile(adapterConfigFilePath).Delete()

            End If

        End If



        '检查AdapterConfig.xml文件是否存在：若存在，则读取文件的值，并显示在窗体上

        If (fso.FileExists(adapterConfigFilePath) = False) Then



            '创建文件

            If (MsgBox(adapterConfigFilePath & "不存在，现在就创建该文件吗？", vbYesNo, "创建文件提示") = vbYes) Then



                Dim root As IXMLDOMElement

                root = xmlDoc.createElement("AdapterConfig")

                xmlDoc.documentElement = root



                root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))

                '添加 AdapterName 节点

                Dim eleAdpName As IXMLDOMElement

                eleAdpName = xmlDoc.createElement("AdapterName")

                root.appendChild(eleAdpName)



                root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))

                '添加 AdapterType 节点

                Dim eleAdpType As IXMLDOMElement

                eleAdpType = xmlDoc.createElement("AdapterType")

                root.appendChild(eleAdpType)



                '设置默认值为“DataBase”

                Dim txtAdpTypeNew As IXMLDOMText

                txtAdpTypeNew = xmlDoc.createTextNode("DataBase")

                eleAdpType.appendChild(txtAdpTypeNew)



                root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))

                '添加 AppParam 节点

                Dim eleAppParam As IXMLDOMElement

                eleAppParam = xmlDoc.createElement("AppParam")

                root.appendChild(eleAppParam)



                eleAppParam.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))

                '添加 PacketSize 节点

                Dim elePacketSize As IXMLDOMElement

                elePacketSize = xmlDoc.createElement("PacketSize")

                eleAppParam.appendChild(elePacketSize)



                eleAppParam.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))

                '添加 HeartBeatTime 节点

                Dim eleHeartBeatTime As IXMLDOMElement

                eleHeartBeatTime = xmlDoc.createElement("HeartBeatTime")

                eleAppParam.appendChild(eleHeartBeatTime)



                eleAppParam.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))



                root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))

                '添加 ThreadNumber 节点

                Dim eleThreadNum As IXMLDOMElement

                eleThreadNum = xmlDoc.createElement("ThreadNumber")

                root.appendChild(eleThreadNum)



                eleThreadNum.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))

                '添加 SendToServer 节点

                Dim eleThreadSendToServer As IXMLDOMElement

                eleThreadSendToServer = xmlDoc.createElement("SendToServer")

                eleThreadNum.appendChild(eleThreadSendToServer)



                eleThreadNum.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))

                '添加 ReceiveApplication 节点

                Dim eleThreadReceiveApp As IXMLDOMElement

                eleThreadReceiveApp = xmlDoc.createElement("ReceiveApplication")

                eleThreadNum.appendChild(eleThreadReceiveApp)



                eleThreadNum.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))



                root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))

                '添加 NoDataWaitTime 节点

                Dim eleNoDataWaitTime As IXMLDOMElement

                eleNoDataWaitTime = xmlDoc.createElement("NoDataWaitTime")

                root.appendChild(eleNoDataWaitTime)



                eleNoDataWaitTime.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))

                '添加 SendToServer 节点

                Dim eleNoDataSendToServer As IXMLDOMElement

                eleNoDataSendToServer = xmlDoc.createElement("SendToServer")

                eleNoDataWaitTime.appendChild(eleNoDataSendToServer)



                eleNoDataWaitTime.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))

                '添加 ReceiveApplication 节点

                Dim eleNoDataReceiveApp As IXMLDOMElement

                eleNoDataReceiveApp = xmlDoc.createElement("ReceiveApplication")

                eleNoDataWaitTime.appendChild(eleNoDataReceiveApp)



                eleNoDataWaitTime.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))



                root.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))

                '添加 FailedOperationWaitTime 节点

                Dim eleFailedWaitTime As IXMLDOMElement

                eleFailedWaitTime = xmlDoc.createElement("FailedOperationWaitTime")

                root.appendChild(eleFailedWaitTime)



                eleFailedWaitTime.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))

                '添加 SendToServer 节点

                Dim eleFailedSendToServer As IXMLDOMElement

                eleFailedSendToServer = xmlDoc.createElement("SendToServer")

                eleFailedWaitTime.appendChild(eleFailedSendToServer)



                eleFailedWaitTime.appendChild(xmlDoc.createTextNode(vbCrLf & Space(16)))

                '添加 ReceiveApplication 节点

                Dim eleFailedReceiveApp As IXMLDOMElement

                eleFailedReceiveApp = xmlDoc.createElement("ReceiveApplication")

                eleFailedWaitTime.appendChild(eleFailedReceiveApp)



                eleFailedWaitTime.appendChild(xmlDoc.createTextNode(vbCrLf & Space(8)))



                root.appendChild(xmlDoc.createTextNode(vbCrLf))

            End If

        End If



        ' //************* 上面的内容都保存在xmlDoc 中，在点击“保存”按钮的时候，暂不保存到文件，新创建一个xmlDocFormat 对象，读取 xmlDoc 对象中的值，填充到 xmlDocFormat 文档中，加上换行和空格，进行格式化操作 ************//



        '''''''' 格式化生成的xml文件 '''''''''''''



        '如果文件存在，但大小为0字节，则删除该文件，重新创建之

        If (fso.FileExists(adapterConfigFilePath) = True) Then

            fso.GetFile(adapterConfigFilePath).Delete()

            fso.CreateTextFile(adapterConfigFilePath)

        End If



        Dim xmlDocFormat As DOMDocument50

        Dim versionFormat As IXMLDOMProcessingInstruction



        xmlDocFormat = New DOMDocument50

        xmlDocFormat.async = False

        xmlDocFormat.Load(adapterConfigFilePath)



        '添加xml文件版本号，编码语言

        versionFormat = xmlDocFormat.createProcessingInstruction("xml", "version=" & Chr(34) & "1.0" & Chr(34) & Space(8) & "encoding=" & Chr(34) & "GBK" & Chr(34))

        xmlDocFormat.appendChild(versionFormat)



        '添加根结点

        Dim rootFormat As IXMLDOMElement

        rootFormat = xmlDocFormat.createElement("AdapterConfig")

        xmlDocFormat.documentElement = rootFormat





        '添加xml文件格式：换行+空格 (1级节点) 

        rootFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf & Space(4)))



        '添加 AdapterName 节点

        Dim eleAdpNameFormat As IXMLDOMElement

        eleAdpNameFormat = xmlDocFormat.createElement("AdapterName")

        rootFormat.appendChild(eleAdpNameFormat)



        '设置 AdapterName 节点的值

        Dim txtAdpNameFormat As IXMLDOMText

        txtAdpNameFormat = xmlDocFormat.createTextNode(Root.selectSingleNode("AdapterName").text)

        eleAdpNameFormat.appendChild(txtAdpNameFormat)



        '添加xml文件格式：换行+空格 (1级节点) 

        rootFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf & Space(4)))



        '添加 AdapterType 节点

        Dim eleAdpTypeFormat As IXMLDOMElement

        eleAdpTypeFormat = xmlDocFormat.createElement("AdapterType")

        rootFormat.appendChild(eleAdpTypeFormat)



        '设置 AdapterType 节点的值

        Dim txtAdpTypeFormat As IXMLDOMText

        txtAdpTypeFormat = xmlDocFormat.createTextNode(Root.selectSingleNode("AdapterType").text)

        eleAdpTypeFormat.appendChild(txtAdpTypeFormat)



        '添加xml文件格式：换行+空格 (1级节点) 

        rootFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf & vbCrLf & Space(4)))



        '添加 AppParam 节点

        Dim eleAppParamFormat As IXMLDOMElement

        eleAppParamFormat = xmlDocFormat.createElement("AppParam")

        rootFormat.appendChild(eleAppParamFormat)



        '添加xml文件格式：换行+空格+空格 (2级节点) 

        eleAppParamFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf & Space(8)))



        '添加 PacketSize 节点

        Dim elePacketSizeFormat As IXMLDOMElement

        elePacketSizeFormat = xmlDocFormat.createElement("PacketSize")

        eleAppParamFormat.appendChild(elePacketSizeFormat)



        '设置 PacketSize 节点的值

        Dim txtPacketSizeFormat As IXMLDOMText

        txtPacketSizeFormat = xmlDocFormat.createTextNode(Root.selectSingleNode("AppParam/PacketSize").text)

        elePacketSizeFormat.appendChild(txtPacketSizeFormat)





        '添加xml文件格式：换行+空格+空格 (2级节点) 

        eleAppParamFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf & Space(8)))



        '添加 HeartBeatTime 节点

        Dim eleHeartBeatTimeFormat As IXMLDOMElement

        eleHeartBeatTimeFormat = xmlDocFormat.createElement("HeartBeatTime")

        eleAppParamFormat.appendChild(eleHeartBeatTimeFormat)



        '设置 HeartBeatTime 节点的值

        Dim txtHeartBeatTimeFormat As IXMLDOMText

        txtHeartBeatTimeFormat = xmlDocFormat.createTextNode(Root.selectSingleNode("AppParam/HeartBeatTime").text)

        eleHeartBeatTimeFormat.appendChild(txtHeartBeatTimeFormat)



        '添加xml文件格式：换行+空格格 (1级节点) 

        eleAppParamFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf & Space(4)))



        '添加xml文件格式：换行+空格 (1级节点) 

        rootFormat.appendChild(xmlDocFormat.createTextNode(vbCrLf))



        xmlDocFormat.save(adapterConfigFilePath)

        MsgBox("保存成功！")

 

Dim oFileSys As Scripting.FileSystemObject
        Dim oFile As Scripting.TextStream

        Dim sFileName As String
        Dim xmlDoc As MSXML2.DOMDocument
        Dim Root As MSXML2.IXMLDOMElement
        Dim Rs As ADODB.Recordset
        Dim Conn As ADODB.Connection
        Dim tempNode As MSXML2.IXMLDOMNode
        Dim emp As MSXML2.IXMLDOMElement

        oFileSys = New Scripting.FileSystemObject
        sFileName = GetExportDir() & VB6.Format(iTaxYr, "0000") & sTaxFile

        'delete old tax file
        If oFileSys.FileExists(sFileName) Then
            oFileSys.DeleteFile(sFileName)
        End If

        oFile = oFileSys.OpenTextFile(sFileName, Scripting.IOMode.ForWriting, True)

        '生成一个XML DOMDocument对象
        xmlDoc = New MSXML2.DOMDocument
        xmlDoc.validateOnParse = False
        xmlDoc.async = False

        '生成根节点并把它设置为文件的根
        Root = xmlDoc.createElement("employees")
        xmlDoc.documentElement = Root
        '在节点上添加多个属性
        Call Root.setAttribute("xmlns:xsi", "http://www.w3.org/2001/XMLSchema-instance")
        Call Root.setAttribute("xmlns", "http://www.kingdee.com/ReK3Inventory")

 

如何通过VB处理XML 
首先要引用一个Microsoft XML 随便选个版本。 
在初始化的时候读取XML显示到TXTBOX中，代码如下： '通过2进制流将XML文件读出来，也可以是其它文件格式
Private Function pstrUpdateView(istrXMLPath As String) As String
    Dim wlngFreeFile As Long
    Dim wbytwbytLoadBytes() As Byte
    '获得一个空闲文件号
    wlngFreeFile = FreeFile
    Open istrXMLPath For Binary As #wlngFreeFile
    ReDim wbytLoadBytes(1 To LOF(wlngFreeFile)) As Byte
    Get #wlngFreeFile, , wbytLoadBytes
    Close wlngFreeFile
    
    pstrUpdateView = StrConv(wbytLoadBytes, vbUnicode)
End Function
装载XML。传进去一个XML地址，如果装载不成功就error，成功则执行下一步 Private Sub fsubLoadXML(istrXMLPath As String)
    Set pobjXMLDoc = CreateObject("MSXML2.DOMDocument")
    If pobjXMLDoc.Load(istrXMLPath) = False Then
        On Error GoTo LoadXMLErr:
    End If
    
    On Error GoTo 0
    Exit Sub
LoadXMLErr:
    Dim myErr
    Set myErr = pobjXMLDoc.parseError
    MsgBox ("ERROR：" & myErr.reason)
    Set myErr = Nothing
End Sub
读属性。DOMDocument对象里有2个读节点的方法：
selectNodes() 如果根节点下有多个子节点就要用这个方法，item定义了第几个子节点
selectSingleNode()如果根节点下只有一个字节点可以用这个方法

Private Function fstrReadAttr(istrNodes As String, istrAttribute As String) As String
On Error GoTo ErrHandle:
    Dim wobjXmlAttr As MSXML2.IXMLDOMAttribute
    '
'    Set wobjXmlAttr = pobjXMLDoc.selectNodes(istrNodes).Item(0).Attributes.getNamedItem(istrAttribute)
    '
    Set wobjXmlAttr = pobjXMLDoc.selectSingleNode(istrNodes).Attributes.getNamedItem(istrAttribute)
    fstrReadAttr = wobjXmlAttr.Text
    
    'destroy object
    Set wobjXmlAttr = Nothing
    On Error GoTo 0
    Exit Function
ErrHandle:
    MsgBox Err.Description
    Set wobjXmlAttr = Nothing
End Function

读节点。 call fstrReadNode("/test/user") ,参数是test节点下的user子节点 Private Function fstrReadNode(istrNodes As String) As String
    Dim xNode As MSXML2.IXMLDOMNode
    Set xNode = pobjXMLDoc.selectSingleNode(istrNodes)
    fstrReadNode = xNode.Text
    Set xNode = Nothing
End Function
写节点。参数1：节点；参数2：需要写入的值 Private Sub fsubWriteNode(istrNodes As String, istrValue As String)
    Dim wobjXMLNode As IXMLDOMElement
    
    Set wobjXMLNode = pobjXMLDoc.documentElement.selectNodes(istrNodes).Item(0)

    wobjXMLNode.Text = istrValue

     Set wobjXMLNode = Nothing
End Sub



a sample :download



--------------------------------------------------------------------------------
转自：http://blog.csdn.net/kinytx/

MSXML 处理 xml 文档时外部DTD定义的问题（ASP）
项目中碰到这个问题，所以也贴了出来

xmlfile = "http://myserver/catalog.xml"
xslfile = "catalog.xsl"

' 创建相关对象
Set xslDoc = server.CreateObject("MSXML2.FreeThreadedDOMDocument")
Set xmlDoc = server.CreateObject("MSXML2.DOMDocument")

' 读取xsl文件
xsldoc.async = False
xsldoc.resolveExternals = True
xsldoc.load server.MapPath(xslfile)
' 读取xml文件
xmldoc.setProperty "ServerHTTPRequest",True  ' 设置ServerHTTPRequest 属性为 True 为了通过http协议载入xml文档
xmldoc.async = False ' 设置 async属性为 False 关闭异步调用
xmldoc.resolveExternals = True ' 设置 resolveExternals 为 True 打开外部DTD分析
xmldoc.validateOnParse = False ' 设置 validateOnParse 为 False 允许文档验证
xmldoc.load xmlfile ' 读取xml文档
Do While (xmldoc.ReadyState < 4)  ' 检查ReadyState状态值是否为4 ' 具体数值定义参见msxml sdk document
   xmldoc.waitForResponse 10 ' 通过waitForResponse方法等待文档完全读取完毕 ' 如果为读取完成，系统暂停10毫秒
Loop

' 转换xml -> html 并输出文档
xmldoc.transformNodeToObject xsldoc,Response

' 清空对象
Set xslt = Nothing
Set xsldoc = Nothing
Set xmldoc = Nothing

 

<?xml version="1.0" encoding="UTF-8"?>
<IR56B xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:noNamespaceSchemaLocation="ir56b.xsd">
  <Section>6A1</Section>
  <ERN>01234561</ERN>
  <YrErReturn>2014</YrErReturn>
  <SubDate>20140420</SubDate>
  <ErName>ABCD COMPANY</ErName>
  <Designation>PARTNER</Designation>
  <NoRecordBatch>00002</NoRecordBatch>
  <TotIncomeBatch>360000</TotIncomeBatch>
    <Employee>
    <SheetNo>000001</SheetNo>
    <HKID>A1144556</HKID>
    <TypeOfForm>O</TypeOfForm>
    <Surname>AUYEUNG</Surname>
    <GivenName>TAI MAN</GivenName>
    <NameInChinese>歐陽大文</NameInChinese>
    <Sex>M</Sex>
    <MaritalStatus>2</MaritalStatus>
    <PpNum />
    <SpouseName>WONG, MEI MEI</SpouseName>
    <SpouseHKID>A456789A</SpouseHKID>
    <SpousePpNum />
    <ResAddr>Flat A, 8/F, 5 Mei Lai Road </ResAddr>
    <AreaCodeResAddr>K</AreaCodeResAddr>
    <PosAddr />
    <Capacity>CLERK</Capacity>
    <PtPrinEmp />
    <StartDateOfEmp>20130401</StartDateOfEmp>
    <EndDateOfEmp>20140331</EndDateOfEmp>
    <PerOfSalary>20130401 - 20140331</PerOfSalary>
    <AmtOfSalary>100000</AmtOfSalary>
    <PerOfLeavePay />
    <AmtOfLeavePay>0</AmtOfLeavePay>
    <PerOfDirectorFee />
    <AmtOfDirectorFee>0</AmtOfDirectorFee>
    <PerOfCommFee />
    <AmtOfCommFee>0</AmtOfCommFee>
    <PerOfBonus>20130401 - 20140331</PerOfBonus>
    <AmtOfBonus>50000</AmtOfBonus>
    <PerOfBpEtc />
    <AmtOfBpEtc>0</AmtOfBpEtc>
    <PerOfPayRetire />
    <AmtOfPayRetire>0</AmtOfPayRetire>
    <PerOfSalTaxPaid />
    <AmtOfSalTaxPaid>0</AmtOfSalTaxPaid>
    <PerOfEduBen />
    <AmtOfEduBen>0</AmtOfEduBen>
    <PerOfGainShareOption />
    <AmtOfGainShareOption>0</AmtOfGainShareOption>
    <NatureOtherRAP1 />
    <PerOfOtherRAP1 />
    <AmtOfOtherRAP1>0</AmtOfOtherRAP1>
    <NatureOtherRAP2 />
    <PerOfOtherRAP2 />
    <AmtOfOtherRAP2>0</AmtOfOtherRAP2>
    <NatureOtherRAP3 />
    <PerOfOtherRAP3 />
    <AmtOfOtherRAP3>0</AmtOfOtherRAP3>
    <PerOfPension />
    <AmtOfPension>0</AmtOfPension>
    <TotalIncome>150000</TotalIncome>
    <PlaceOfResInd>0</PlaceOfResInd>
    <AddrOfPlace1 />
    <NatureOfPlace1 />
    <PerOfPlace1 />
    <RentPaidEr1>0</RentPaidEr1>
    <RentPaidEe1>0</RentPaidEe1>
    <RentRefund1>0</RentRefund1>
    <RentPaidErByEe1>0</RentPaidErByEe1>
    <AddrOfPlace2 />
    <NatureOfPlace2 />
    <PerOfPlace2 />
    <RentPaidEr2>0</RentPaidEr2>
    <RentPaidEe2>0</RentPaidEe2>
    <RentRefund2>0</RentRefund2>
    <RentPaidErByEe2>0</RentPaidErByEe2>
    <OverseaIncInd>0</OverseaIncInd>
    <AmtPaidOverseaCo />
    <NameOfOverseaCo />
    <AddrOfOverseaCo />
    <Remarks />
  </Employee>
  <Employee>
    <SheetNo>000002</SheetNo>
    <HKID>K1234560</HKID>
    <TypeOfForm>O</TypeOfForm>
    <Surname>LEE</Surname>
    <GivenName>SIU SUM</GivenName>
    <NameInChinese>李小森</NameInChinese>
    <Sex>F</Sex>
    <MaritalStatus>1</MaritalStatus>
    <PpNum />
    <SpouseName />
    <SpouseHKID />
    <SpousePpNum />
    <ResAddr>Flat B 2/F Block C Happy Garden 1 Happy Road </ResAddr>
    <AreaCodeResAddr>H</AreaCodeResAddr>
    <PosAddr />
    <Capacity>MANAGER</Capacity>
    <PtPrinEmp />
    <StartDateOfEmp>20130401</StartDateOfEmp>
    <EndDateOfEmp>20140331</EndDateOfEmp>
    <PerOfSalary>20130401 - 20140331</PerOfSalary>
    <AmtOfSalary>210000</AmtOfSalary>
    <PerOfLeavePay />
    <AmtOfLeavePay>0</AmtOfLeavePay>
    <PerOfDirectorFee />
    <AmtOfDirectorFee>0</AmtOfDirectorFee>
    <PerOfCommFee />
    <AmtOfCommFee>0</AmtOfCommFee>
    <PerOfBonus />
    <AmtOfBonus>0</AmtOfBonus>
    <PerOfBpEtc />
    <AmtOfBpEtc>0</AmtOfBpEtc>
    <PerOfPayRetire />
    <AmtOfPayRetire>0</AmtOfPayRetire>
    <PerOfSalTaxPaid />
    <AmtOfSalTaxPaid>0</AmtOfSalTaxPaid>
    <PerOfEduBen />
    <AmtOfEduBen>0</AmtOfEduBen>
    <PerOfGainShareOption />
    <AmtOfGainShareOption>0</AmtOfGainShareOption>
    <NatureOtherRAP1 />
    <PerOfOtherRAP1 />
    <AmtOfOtherRAP1>0</AmtOfOtherRAP1>
    <NatureOtherRAP2 />
    <PerOfOtherRAP2 />
    <AmtOfOtherRAP2>0</AmtOfOtherRAP2>
    <NatureOtherRAP3 />
    <PerOfOtherRAP3 />
    <AmtOfOtherRAP3>0</AmtOfOtherRAP3>
    <PerOfPension />
    <AmtOfPension>0</AmtOfPension>
    <TotalIncome>210000</TotalIncome>
    <PlaceOfResInd>1</PlaceOfResInd>
    <AddrOfPlace1>Flat B 21/F Block C Happy Garden 1 Happy Garden 1 Happy Road HK</AddrOfPlace1>
    <NatureOfPlace1>Flat</NatureOfPlace1>
    <PerOfPlace1>20130401 - 20140331</PerOfPlace1>
    <RentPaidEr1>0</RentPaidEr1>
    <RentPaidEe1>120000</RentPaidEe1>
    <RentRefund1>120000</RentRefund1>
    <RentPaidErByEe1>0</RentPaidErByEe1>
    <AddrOfPlace2 />
    <NatureOfPlace2 />
    <PerOfPlace2 />
    <RentPaidEr2>0</RentPaidEr2>
    <RentPaidEe2>0</RentPaidEe2>
    <RentRefund2>0</RentRefund2>
    <RentPaidErByEe2>0</RentPaidErByEe2>
    <OverseaIncInd>0</OverseaIncInd>
    <AmtPaidOverseaCo />
    <NameOfOverseaCo />
    <AddrOfOverseaCo />
    <Remarks />
  </Employee>
</IR56B>

 

 Private Sub GenerateTaxFile(ByRef iTaxYr As Short)
        On Error GoTo erhd
        Dim oFileSys As Scripting.FileSystemObject
        Dim oTextStream As Scripting.TextStream

        Dim oSQL As ClsMySQL
        'Dim rsRv As ADODB.Recordset
        Dim sBuffer As String
        Dim sBufferHeader As String
        Dim sFileName 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

        oFileSys = New Scripting.FileSystemObject
        sFileName = GetExportDir() & VB6.Format(iTaxYr, "0000") & sTaxFile

        'delete old tax file
        If oFileSys.FileExists(sFileName) Then
            oFileSys.DeleteFile(sFileName)
        End If

        oTextStream = oFileSys.OpenTextFile(sFileName, Scripting.IOMode.ForWriting, True)
        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()

            sBuffer = FillStringWithSpaceRight(VB.Left(sEmpyrTaxFIleNo, 3), 3)
            sBuffer = sBuffer & FillStringWithSpaceRight(VB.Right(sEmpyrTaxFIleNo, 8), 8)
            sBuffer = sBuffer & FillStringWithSpaceRight(CStr(iTaxYr), 4)
            sBuffer = sBuffer & FillStringWithSpaceRight(sSubDte, 8)
            sBuffer = sBuffer & FillStringWithZero(CStr(lBtNo), 5)
            sBuffer = sBuffer & New String("0", 6)
            sBuffer = sBuffer & Space(9)
            sBuffer = sBuffer & FillStringWithSpaceRight(sEmpyrNm, 70)
            sBuffer = sBuffer & FillStringWithSpaceRight(sDesgn, 25)
            sBuffer = sBuffer & FillStringWithZero(CStr(lRecordCount), 5)
            sBuffer = sBuffer & FillStringWithZero(CStr(cTotAmt), 11)
            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

                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)

            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

 

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

        '生成一个XML DOMDocument对象
        xmlDoc = New MSXML2.DOMDocument

        '生成根节点并把它设置为文件的根
        'Root = xmlDoc.createElement("employees")
        'xmlDoc.documentElement = Root
        '-------------------------------------
        oTextStream = oFileSys.OpenTextFile(sFileName, Scripting.IOMode.ForWriting, True)
        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()

            sBuffer = FillStringWithSpaceRight(VB.Left(sEmpyrTaxFIleNo, 3), 3)
            sBuffer = sBuffer & FillStringWithSpaceRight(VB.Right(sEmpyrTaxFIleNo, 8), 8)
            sBuffer = sBuffer & FillStringWithSpaceRight(CStr(iTaxYr), 4)
            sBuffer = sBuffer & FillStringWithSpaceRight(sSubDte, 8)
            sBuffer = sBuffer & FillStringWithZero(CStr(lBtNo), 5)
            sBuffer = sBuffer & New String("0", 6)
            sBuffer = sBuffer & Space(9)
            sBuffer = sBuffer & FillStringWithSpaceRight(sEmpyrNm, 70)
            sBuffer = sBuffer & FillStringWithSpaceRight(sDesgn, 25)
            sBuffer = sBuffer & FillStringWithZero(CStr(lRecordCount), 5)
            sBuffer = sBuffer & FillStringWithZero(CStr(cTotAmt), 11)
            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

                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