Function CopyData(sql As String, cnFrom As ADODB.Connection, cnTo As ADODB.Connection) As Boolean
Dim rs As New ADODB.Recordset
Dim st As New ADODB.Stream
Dim s As String
    On Error GoTo errh:
    rs.Open sql, cnFrom, adOpenStatic, adLockBatchOptimistic
    st.Type = adTypeText
    st.Open
    rs.Save st, adPersistXML
    rs.Close
    s = st.ReadText
    st.Close
    s = Replace(s, _
        "rs:basecatalog='" & cnFrom.Properties("Current Catalog").Value & "'", _
        "rs:basecatalog='" & cnTo.Properties("Current Catalog").Value & "'")
    s = Replace(s, "<rs:data>", "<rs:data><rs:insert>")
    s = Replace(s, "</rs:data>", "</rs:insert></rs:data>")
    st.Open
    st.WriteText s
    st.Position =  0 
    rs.Open st
    Set rs.ActiveConnection = cnTo
    rs.UpdateBatch
    rs.Close
    CopyData = True
errh:
End Function