RE:AYUDA CON STORE PROCEDUE
Espero te Sirva...
Sub SendToSQL_Empleados()
'The code uses ADO to establish a SQL Server connection and passes in a
'template to the server. The template executes a stored procedure
'(update_employee) which accepts an XML document as input. The stored
'procedure uses OPENXML to shred the document and generate a rowset
'which is used to update the records in the Employee table.
'The template is then executed on the server and the resulting stream
'is returned to the client. The stream contains the resulting XML
'document.
Dim objStrmIn As New ADODB.Stream
Dim objStrmOut As New ADODB.Stream
Dim FILELENGTH
Dim binbyte
Dim varSQLXML
On Error GoTo Errorlabel
oBitacora.Write Now() & " " & TextoModo & " : " & "-> SendToSQLServer_Empleados Ready" & vbCrLf
' Open a connection to the SQL Server.
objConnection.Provider = "SQLOLEDB"
objConnection.Open "Data Source=" & DBServer & ";Initial Catalog=" & DBCatalog & _
";User Id=" & DBUser & ";Password=" & DBPass & "; "
objConnection.CommandTimeout = 150
Set objCommand.ActiveConnection = objConnection
Open FileNameXML_1 For Input As #1
FILELENGTH = FileLen(FileNameXML_1) ' Get length of file.
'Debug.Print FILELENGTH
binbyte = Input(FILELENGTH, #1)
' Quita los postrofes que haya en algun Texto
binbyte = Replace(binbyte, "'", " ")
' Build the command string in the form of an XML template.
varSQLXML = "<root xmlns:sql=""urn:schemas-microsoft-com:xml-sql""><sql:query><![CDATA["
varSQLXML = varSQLXML & "exec kr_insert_employee_H N'"
varSQLXML = varSQLXML & Mid(binbyte, 1, FILELENGTH) & "']]>"
varSQLXML = varSQLXML & "</sql:query></root>"
' Set the command dialect to XML.
objCommand.Dialect = "{5d531cb2-e6ed-11d2-b252-00c04f681b71}"
' Open the command stream and write our template to it.
objStrmIn.Open
objStrmIn.WriteText varSQLXML
objStrmIn.Position = 0
Set objCommand.CommandStream = objStrmIn
' Execute the command, open the return stream, and read the result.
objStrmOut.Open
objStrmOut.LineSeparator = adCRLF
objCommand.Properties("Output Stream").Value = objStrmOut
objCommand.Execute , , adExecuteStream
objStrmOut.Position = 0
Debug.Print objStrmOut.ReadText
Set objCommand = Nothing
'Actualiza tabla de conversión de niveles
varSQL = "exec KRPR_NIVEL"
Dim objRecSet As New ADODB.Recordset
Set objRecSet = objConnection.Execute(varSQL)
Set objRecSet = Nothing
Set objStrmIn = Nothing
Set objStrmOut = Nothing
Set objConnection = Nothing
Close #1
oBitacora.Write Now() & " " & TextoModo & " : " & "-> SendToSQLServer_Empleados OK" & vbCrLf
Exit Sub
Errorlabel:
Call Fallas(Err.Number, Err.Source, Err.Description)
oBitacora.Close
End ' Stop Process
End Sub
Store Procedure en SQL Server
CREATE PROC kr_insert_employee_H
@empdata ntext
AS
DECLARE @hDoc int
DELETE FROM kr_empleados_H
EXEC sp_xml_preparedocument @hDoc OUTPUT, @empdata
INSERT INTO kr_empleados_H
SELECT *
FROM OPENXML(@hDoc, '/APPSCONTROL/EMPLEADO')
WITH kr_empleados_H
EXEC sp_xml_removedocument @hDoc
GO