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
相关推荐
标题中的"VB_XML.rar_ VB_XML_VB speeaksdk xml_vb xml_xml_xml vb"表明这个压缩包包含了与Visual Basic（VB）编程语言和XML处理相关的代码示例。XML，全称Extensible Markup Language，是一种用于存储和传输数据的...
标题中的"VB_xml_Class.rar_vb xml_vb xml class_xml"暗示了这是一个使用Visual Basic (VB)编程语言编写的XML处理类库。这个类库可能是为了简化XML文档的读取、写入和操作而设计的，具有良好的可移植性，意味着可以...
XMLDOM（XML Document Object Model）是用于解析和操作XML文档的标准接口，而XMLDocument类是VB.NET中实现XMLDOM的具体类，可以方便地加载、解析和操作XML数据。 1. **XMLDOM对象模型**： - **Document Object ...
在这个“XML.rar_TreeView vb_VB XML TreeView_treeview xml_vb treeview_v”项目中，我们将深入探讨如何在VB.NET中使用TreeView控件来展示XML数据。 首先，让我们理解XML的基本概念。XML（eXtensible Markup ...
在VB（Visual Basic）编程环境中，XML（eXtensible Markup Language）是一种常见的数据交换格式，用于存储和传输结构化数据。本实例是关于如何在VB中解析XML文件的入门教程，适合初学者学习和参考。 XML文件是一种...
对dom对象进一步简化， 方便的打开、读取和修改xml文件
VB XML文件读取并操作类 ^_^ E动天下—VB专业源码网 (http:/www.2e3.org) 本站是一个免费的基于VB，VB.NET源代码交流的平台，为大家提供优质的专业的源代码，如果您有需要，本站可以帮助在业余时间里给您寻找代码。...
在VB（Visual Basic）编程中，处理XML文件是常见的任务之一。XML（eXtensible Markup Language）是一种用于存储和传输数据的结构化格式，它允许程序员以清晰、灵活的方式组织信息。本实例将深入探讨如何在VB环境中不...
在VB（Visual Basic）环境中，处理XML文件通常涉及到读取、写入和解析XML文档。本实例通过VB代码展示了如何分节点读取XML数据。 首先，我们需要了解XML的基本结构。XML文档由一系列元素组成，每个元素可能包含其他...
用VB操作XML '生成一个XML DOMDocument对象 Set xmlDOMDocument = New MSXML2.DOMDocument '生成根节点，在此我们称它为“爷爷辈”节点 Set Root_Node = xmlDOMDocument.createElement("Root") Set ...
首先，VB.NET提供了System.Xml命名空间，其中包含了一系列类，如XmlDocument、XmlNode、XmlElement等，用于处理XML文档。在"WindowsApplication(writexml)"项目中，我们可以看到如何创建并写入XML文档。基本步骤如下...
VB.net读取XML标签值，两种方法，一是加载XML字符串，一是加载XML文件，然后再从节点路径中读TAG第一个匹配值
在VB（Visual Basic）编程环境中，XML（Extensible Markup Language）是一种常用的数据交换格式，用于存储和传输结构化数据。本篇文章将详细讲解如何利用VB来操作XML，以标题"用VB操作XML的程序代码"为例，我们将...
VB（Visual Basic）作为Microsoft开发的一种面向对象的编程语言，提供了对XML的内置支持，使得开发者能够轻松地进行XML文件的读写操作。在VB中处理XML，主要涉及到的知识点包括XML DOM（Document Object Model）模型...
在VB（Visual Basic）编程环境中，处理XML（Extensible Markup Language）是一项常见的任务，尤其是在进行数据交换、存储或解析时。XML是一种结构化的数据格式，它独立于软件和硬件平台，便于人和机器阅读。本资源...
在VB（Visual Basic）编程中，解析XML文件是一项常见的任务，尤其在处理数据交换、配置文件或存储结构化数据时。XML（eXtensible Markup Language）是一种自定义标记语言，设计用于传输和存储数据，它具有良好的...
本示例中的“VB导入导出XML文件”可能是通过VB编写的一个程序，该程序实现了从XML文件中读取数据并显示在一个网格（如DataGridView）中，同时也能将用户在网格中的修改保存回XML文件。这样的功能对于数据管理、配置...
在VB（Visual Basic）编程中，XML（Extensible Markup Language）是一种常用的数据交换格式，用于存储和传输结构化数据。本篇文章将详细讲解如何使用VB来操纵XML文档，特别是读取其中的节点信息。 首先，我们需要...
### VB读取XML文件知识点详解 #### 一、概述 在软件开发过程中，XML（可扩展标记语言）因其良好的结构化特性，在数据交换与存储方面得到了广泛应用。Visual Basic（简称VB），作为一款功能强大的编程语言，支持...