Code:
Public Function SaveRSToXML(ConnectionString As String, _ SQLString As String, FullPath As String) As Boolean '************************************************** 'PURPOSE: SAVE A RECORDSET TO AN XML FILE USING 'ADO 2.5 'PARAMETERS: 'ConnectionString: Valid Connection String 'SQLString: Valid SQL Statement for Data Source specified ' in ConnectionString 'FullPath: FullPath of XMLFile to write to 'RETURNS: True if Sucessful, false otherwise 'REQUIRES: Installation of and reference to ADO 2.5 'EXAMPLE of SaveRsToXML and LoadRSToXML: 'Dim sConnString As String 'Dim sSQL As String 'Dim oRs As ADODB.Recordset 'Dim iCtr As Integer 'sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data 'Source=C:\MyDb.mdb" 'sSQL = "select * from MyTable" 'SaveRSToXML sConnString, sSQL, "C:\My Documents\MyRs.xml" 'Set oRs = LoadRsFromXML("C:\my documents\MyRS.xml") 'If Not oRs Is Nothing Then ' Do While Not oRs.EOF ' For iCtr = 0 To oRs.Fields.Count - 1 ' Debug.Print oRs.Fields(iCtr).Name & " = " _ ' & oRs.Fields(iCtr).Value & ";"; ' Next ' Debug.Print vbCrLf ' oRs.MoveNext ' Loop ' set oRs = nothing 'End If '****************************************************** Dim oCn As New ADODB.Connection Dim oCmd As New ADODB.Command Dim oRs As ADODB.Recordset On Error GoTo ErrorHandler: oCn.ConnectionString = ConnectionString oCn.Open Set oCmd.ActiveConnection = oCn oCmd.CommandText = SQLString oCmd.CommandType = adCmdText Set oRs = oCmd.Execute oRs.Save FullPath, adPersistXML SaveRSToXML = True ErrorHandler: On Error Resume Next Set oRs = Nothing Set oCmd = Nothing If oCn.State <> 0 Then oCn.Close Set oCn = Nothing End Function Public Function LoadRsFromXML(FullPath As String) As _ ADODB.Recordset '************************************************** 'PURPOSE: LOAD A RECORDSET FROM AN XML FILE USING 'ADO 2.5. THE XML FILE MUST HAVE BEEN SAVED 'USING SAVE METHOD OF RECORDSET OBJECT WITH adPersistXML AD 'SECOND PARAMETER 'PARAMETERS: 'FullPath: FullPath of XMLFile to load 'RETURNS: Reference to a Recordset Object, or Nothing if ' Function fails 'REQUIRES: Installation of and reference to ADO 2.5 'EXAMPLE: See Example for SaveRsToXML '****************************************************** Dim oRs As New ADODB.Recordset On Error Resume Next If Dir(FullPath) = "" Then Exit Function oRs.Open FullPath, "Provider=MSPersist;", adOpenForwardOnly, _ adLockReadOnly, adCmdFile If Err.Number = 0 Then Set LoadRsFromXML = oRs End If End Function