VB產生xml格式檔案…

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