如何用VB生成XML文件
我做了个VB程序,将台达PLC和计算机通信,将PLC的数据读到计算机中,但是客户要求将数据用XML格式保存,这个用VB怎么编?望各位大侠指点,谢谢!shgzldy@
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
child.Text = CL(oRsTemp.Fields(i))
Else
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