Consultas a la BD de SAP desde un programa en VB

[doraxploradora]

' Conectores a las SAP.Functions.
Dim r3 As Object
Dim MyFunc As Object

' Parametros a enviar a la funcion.
Dim I_VENDOR As Object 'Proveedor como EXPORT

Dim I_HEADER As Object 'Cabecera del Pedido de Compras
Dim E_POSITION As Object 'Detalles como TABLA

' Resultado de la llamada a SAP.
Dim Result1 As Boolean

Dim ORDENDECOMPRA As Object
Dim ENTRADADEMERCANCIA As Object
Dim xPROVEEDOR As Object
Dim E_MESSAGE As Object 'Mensajes como TABLA



Private Sub Envia_Lineas()
' Establecer la conexion con los Add Ins de SAP.

Set r3 = CreateObject("SAP.Functions")

' Cargar los parametros de conexion
'R3.Connection.Messageserver = "SAPSERVQAS" ' Nombre del server
r3.Connection.System = "DEV" ' Sistema
r3.Connection.SystemNumber = "10" 'Instancia
r3.Connection.Applicationserver = "SAPSERVQAS" ' Nombre del server
r3.Connection.Client = "130" ' Mandante
r3.Connection.User = "d.castro" ' Usuario
r3.Connection.Password = "xxxx" ' Password
r3.Connection.language = "ES" ' Idioma

' Ejecutar la conexion en modo INVISIBLE.
If r3.Connection.Logon(0, True) <> True Then
MsgBox "No se ha podido establecer la conexión"
Else
' Establecer contacto con la funcion.
Set MyFunc = r3.Add("ZMMF001") 'Nombre de la funcion ZMMF001 en SAP

'DATOS PARA ENVIAR A SAP

' Cargar los parametros a enviar a la funcion - EXPORTING

' Datos del header- Cabecera del Ticket

Set I_HEADER = MyFunc.Exports("I_HEADER")

MyFunc.Exports.Item("I_HEADER").Value("LIFNR") = rc01(9, 0) 'Codigo del Proveedor
MyFunc.Exports.Item("I_HEADER").Value("BUKRS") = rc01(0, 0) 'Sociedad
MyFunc.Exports.Item("I_HEADER").Value("EKORG") = rc01(1, 0) 'Organizacion de Compras
MyFunc.Exports.Item("I_HEADER").Value("EKGRP") = rc01(10, 0) 'Grupo de Compras
MyFunc.Exports.Item("I_HEADER").Value("IHREZ") = "100" 'Referencia - Codigo del Chofer

' Cargar la tabla con los datos que vamos a enviar - TABLES.

' Datos del E_POSITION - Datos del detalle del ticket

Set E_POSITION = MyFunc.Tables("E_POSITION")

For I = 0 To UBound(rc01, 2)
E_POSITION.Rows.Add
E_POSITION.Value(I + 1, "BEDNR") = rc01(11, I) 'Ticket
E_POSITION.Value(I + 1, "WERKS") = rc01(12, I) 'Centro
E_POSITION.Value(I + 1, "LGORT") = rc01(13, I) 'Almacen
E_POSITION.Value(I + 1, "MATNR") = rc01(14, I) 'Material
E_POSITION.Value(I + 1, "KBETR") = rc01(15, I) 'Importe
E_POSITION.Value(I + 1, "MENGE") = rc01(16, I) - rc01(18, I) 'Cantidad menos cantidad penalizada
E_POSITION.Value(I + 1, "PEINH") = rc01(17, I) 'Cantidad Base
E_POSITION.Value(I + 1, "MENG2") = rc01(18, I) 'Cantidad Penalizada
Next


' Llamar o invocar a la funcion de SAP.
Result1 = MyFunc.Call

' Analizar el resultado de la llamada.
If Result1 = False Then
MsgBox "Error en el llamado a la funcion ZMMF001."
Else
MsgBox "Funcion ZMMF001 ejecutada OK."

'Grabar Tiquet de SAP
Set ORDENDECOMPRA = MyFunc.imports("E_PONUMBER")

MsgBox "La Orden de Compra es: " & ORDENDECOMPRA.Value

Set ENTRADADEMERCANCIA = MyFunc.imports("E_MBLNR")
MsgBox "La Entrada de Mercancia es: " & ENTRADADEMERCANCIA.Value


'Tabla de mensajes donde llegan los mensajes de error sean positivos o negativos

Set E_MESSAGE = MyFunc.Tables("E_MESSAGE")


Dim x As Integer

x = 1

Dim row As Object


For Each row In MyFunc.Tables("E_MESSAGE").Rows

'lstResult.AddItem MyFunc.Tables.Item("E_MESSAGE").Value(x, "TIPO") & " " & MyFunc.Tables.Item("E_MESSAGE").Value(x, "MSG")

MsgBox (MyFunc.Tables.Item("E_MESSAGE").Value(x, "TIPO") & " " & MyFunc.Tables.Item("E_MESSAGE").Value(x, "MSG"))

x = x + 1

Next


End If
' Terminar la sesion en SAP
r3.Connection.Logoff
End If
End Sub