如何基于Access中的表生成XML文件,该表的每1500条记录?

时间:2017-09-12 10:10:54

标签: xml vba ms-access xslt access-vba

我有这个功能可以导出到XML。但是现在我想在表 STOCK_EXE 的每1500条记录中生成文件。我已经尝试了一个带有计数器的While (Not .EOF),但我输了。有谁知道最好的方法吗?

第一版:

Public Function Function_XML_TEST()

    Dim rs              As ADODB.Recordset
    Dim cn              As ADODB.Connection
    Dim myXML           As MSXML2.DOMDocument
    Dim myXSLT          As MSXML2.DOMDocument
    Dim sSQL            As String
    Dim CountString     As String
    Dim LCounter        As Integer
    Dim iCount          As Integer

    Set myXML = New MSXML2.DOMDocument
    myXML.async = False
    myXML.preserveWhiteSpace = False

    Set myXSLT = New MSXML2.DOMDocument
    myXSLT.async = False
    myXSLT.preserveWhiteSpace = False

    Set cn = CurrentProject.Connection
    Set rs = New ADODB.Recordset

    sSQL = "SELECT * FROM STOCK_EXE"

    CountString = "SELECT COUNT(*) FROM STOCK_EXE"

    iCount = CurrentDb.OpenRecordset(CountString).Fields(0).Value

    rs.Open sSQL, cn

    iCount = rs.RecordCount 'Determine the number of returned records

    With rs        

        For LCounter = 0 To iCount Step 1500  

            myXSLT.Load "C:\Users\STOCK_EXE.xslt"
            rs.Save myXML, adPersistXML

            Call myXML.transformNodeToObject(myXSLT.documentElement, myXML)

            If IsNull(Forms!MenuInicial!ProductStatus.Value) Or _ 
               IsNull(Forms!MenuInicial!LpnFacilityStatus.Value) Or _ 
               IsNull(Forms!MenuInicial!InitialAisle.Value) Or _ 
               IsNull(Forms!MenuInicial!FinalAisle.Value) Then
                MsgBox ("As Lovs!")
            Else
                MsgBox ("Criado XML!")
                myXML.Save "C:\Users\" & LCounter & "_" & _ 
                            Forms!MenuInicial!LpnFacilityStatus.Value & "_" & _ 
                            Forms!MenuInicial!InitialAisle.Value & "_" & _ 
                            Forms!MenuInicial!FinalAisle.Value & "_DTIM_" & _
                            Format(Now(), "DDMMYYYY_hhmm") & ".xml"
            End If

        Next LCounter

    End With

    rs.Close
    cn.Close

End Function

我认为我很接近,但它在这一点上给了我以下错误:

rs.OpensSQL, cn
  

“没有给出一个或多个必需参数的值”

第二版:

Public Function Function_XML_TEST_V1()

    Dim rs              As ADODB.Recordset
    Dim cn              As ADODB.Connection
    Dim myXML           As MSXML2.DOMDocument
    Dim myXSLT          As MSXML2.DOMDocument
    Dim sSQL            As String
    Dim CountString     As String
    Dim LCounter        As Integer
    Dim iCount          As Integer

    Set myXML = New MSXML2.DOMDocument
    myXML.async = False
    myXML.preserveWhiteSpace = False

    Set myXSLT = New MSXML2.DOMDocument
    myXSLT.async = False
    myXSLT.preserveWhiteSpace = False

    Set cn = CurrentProject.Connection
    Set rs = New ADODB.Recordset

    CountString = "SELECT COUNT(*) FROM STOCK_EXE_ID"

    iCount = CurrentDb.OpenRecordset(CountString).Fields(0).Value

    MsgBox ("iCount = " & iCount)

    With rs

        For LCounter = 1 To iCount Step 1500

            MsgBox ("LCounter = " & LCounter)

            sSQL = "SELECT * FROM STOCK_EXE_ID" _
                    & " WHERE STOCK_EXE_ID.ID BETWEEN LCounter and (LCounter + 1500)"

            rs.Open sSQL, cn

            myXSLT.Load "C:\Path\To\XSLT\STOCK_EXE.xslt"
            rs.Save myXML, adPersistXML

            Call myXML.transformNodeToObject(myXSLT.documentElement, myXML)

            myXML.Save "C:\Path\To\Output\" & LCounter & "_DTIM_" & _
                        Format(Now(), "DDMMYYYY_hhmm") & ".xml"

            rs.Close
            cn.Close

        Next LCounter

    End With

    MsgBox ("Passou!")

End Function

1 个答案:

答案 0 :(得分:1)

使用表的autonumber字段考虑域聚合DCount,循环范围和SQL以及相关计数子查询,该字段假定在表中作为字段存在, ID

myXSLT.Load "C:\Path\To\XSLT\STOCK_EXE.xslt"   ' MOVED OUTSIDE LOOP

For LCounter = 1 To DCount("*", "STOCK_EXE") Step 1500

      MsgBox ("LCounter = " & LCounter)

      ' SQL WITH CORRELATED COUNT SUBQUERY IN WHERE CLAUSE SERVING AS ROW NUMBER
      sSQL = "SELECT t.* FROM STOCK_EXE t" _
               & " WHERE (SELECT Count(*) FROM STOCK_EXE sub WHERE sub.ID <= t.ID)" _
               & " BETWEEN " & LCounter & " AND " & LCounter + 1499    
      rs.Open sSQL, cn

      ' OUTPUT RAW XML
      rs.Save myXML, adPersistXML

      ' RUN XSLT (NO CALL OR .documentElement NEEDED)
      myXML.transformNodeToObject myXSLT, myXML

      ' SAVE OUTPUT TO FILE
      myXML.Save "C:\Path\To\Output\" & LCounter & "_DTIM_" & _
                  Format(Now(), "DDMMYYYY_hhmm") & ".xml"    
      rs.Close

Next LCounter 

cn.Close

' CLEAR RESOURCES
Set rs = Nothing: Set cn = Nothing
Set myXML = Nothing: Set myXSLT = Nothing