Private Sub Command1_Click()
  
    Dim sConn As String
    Dim sQuery As String
    Dim outStrm
        
    sConn = "Provider=SQLOLEDB;Data Source=.;Initial Catalog=Northwind;User ID=<username>;Password=<strong password>;"
    Dim adoConn As ADODB.Connection
    Set adoConn = New ADODB.Connection
    adoConn.ConnectionString = sConn
    adoConn.CursorLocation = adUseClient
    adoConn.Open
    
    Dim adoCmd As ADODB.Command
       Set adoCmd = New ADODB.Command
       Set adoCmd.ActiveConnection = adoConn
       sQuery = "<ROOT xmlns:sql='urn:schemas-microsoft-com:xml-sql'>" 
       sQuery = sQuery & "<sql:query>SELECT * FROM PRODUCTS FOR XML AUTO</sql:query>"'
       sQuery = sQuery & "</ROOT>"
    
    Dim adoStreamQuery As ADODB.Stream
    Set adoStreamQuery = New ADODB.Stream
    
    '   Open the command stream so it may be written to
    adoStreamQuery.Open                             
    '   Set the input command stream's text with the query string
    adoStreamQuery.WriteText sQuery, adWriteChar    
    '   Reset the position in the stream, otherwise it will be at EOS.
    adoStreamQuery.Position = 0                     
    
    '   Set the command object's command to the input stream set above.
    Set adoCmd.CommandStream = adoStreamQuery       
    '   Set the dialect for the command stream to be a SQL query.
    adoCmd.Dialect = "{5D531CB2-E6Ed-11D2-B252-00C04F681B71}"   
    
    '   Create the output stream to stream the results into.
    Set outStrm = CreateObject("ADODB.Stream")      
    outStrm.Open

    '   Set command's output stream to the output stream just opened.
    adoCmd.Properties("Output Stream") = outStrm    
    
    '   Execute the command, thus filling the output stream.
    adoCmd.Execute , , adExecuteStream              
    '   Position the output stream back to the beginning of the stream.
    outStrm.Position = 0                            
    '   Create temporary string.
    Dim str As String                               
    '   Assign the stream's output to the temp string to format.
    str = outStrm.ReadText(-1)                      
    '   Add a cr/lf pair for each row in the result stream.
    str = Replace(str, "><", ">" & vbCrLf & "<")    
    Debug.Print str
    GoTo Bye
    
RecError:
    Debug.Print Err.Number & ": " & Err.Description
    
Bye:
    Set adoCmd = Nothing
    If adoConn.State = adStateOpen Then
        adoConn.Close
    End If
    Set adoConn = Nothing
End Sub