martes, 22 de noviembre de 2011

ACCEDER A UNA FUNCION SAP DESDE VISUAL BASIC

Private Sub Envia_Proveedor()
     ' 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 = "userensap" ' Usuario
     r3.Connection.Password = "xxxxxx" ' 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("ZFIF002")   'Nombre de la funcion ZFIF002 en SAP creada por un ABAP
       
        'Crea el proveedor si no existe y si existe devuelve un mensaje que ya existe
        'DATOS PARA ENVIAR A SAP
    
        ' Cargar los parametros a enviar a la funcion - EXPORTING
        ' Datos del proveedor  - Si es que no existe se debe enviar estos DATOS a SAP  - si existe esto debe enviarse en blanco
    
        Set I_VENDOR = MyFunc.Exports("I_VENDOR")
         
        MyFunc.Exports.Item("I_VENDOR").Value("BUKRS") = "1000"  'Sociedad
        MyFunc.Exports.Item("I_VENDOR").Value("EKORG") = "1000"  'Organizacion de Compras
        MyFunc.Exports.Item("I_VENDOR").Value("NAME1") = Trim(txtNombre)  'Nombre del Proveedor
        MyFunc.Exports.Item("I_VENDOR").Value("STRAS") = Trim(txtDireccion)  'Direccion
        MyFunc.Exports.Item("I_VENDOR").Value("REGIO") = Format(cboRegion.Column(1), "00")  'Region
        MyFunc.Exports.Item("I_VENDOR").Value("CITY1") = Trim(cboPoblacion.Column(0))  'Poblacion
        MyFunc.Exports.Item("I_VENDOR").Value("STCD1") = Trim(txtRuc)  'ID Fiscal.
        
       
        
        'TIPO NIF  -->   01 ruc       02 cedula
        If Len((MyFunc.Exports.Item("I_VENDOR").Value("STCD1"))) = 10 Then
           MyFunc.Exports.Item("I_VENDOR").Value("STCDT") = "02"     'cedula
        Else
           MyFunc.Exports.Item("I_VENDOR").Value("STCDT") = "01"     'ruc
        End If
        
        'CLASE DE IMPUESTO    SN  sociedad nacional     PN persona natural
        If Len((MyFunc.Exports.Item("I_VENDOR").Value("STCD1"))) = 10 Then
           MyFunc.Exports.Item("I_VENDOR").Value("FITYP") = "PN"
        Else
           MyFunc.Exports.Item("I_VENDOR").Value("FITYP") = "SN"
        End If
        
        
        
        'Aqui falta una pregunta que diga si es o no contribuyente especial

        If Len((MyFunc.Exports.Item("I_VENDOR").Value("STCD1"))) = 10 Then
                 MyFunc.Exports.Item("I_VENDOR").Value("ESPEC") = "0"   'no aplica
             Else
                 MyFunc.Exports.Item("I_VENDOR").Value("ESPEC") = "1"   'especial    '2 ESPECIAL
        End If
             
        ' Cargar la tabla con los datos que vamos a enviar - TABLES.
        ' 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 ZFIF002."
        Else
           MsgBox "Funcion ZFIF002 ejecutada OK."
          
       
            'DATOS PARA RECIBIR LOS DATOS QUE NOS ENVIA LA FUNCION SAP
            ' Recoger los parametros devueltos por la funcion - IMPORTING
            
    
             'Set txtProveedorSAP.Text = MyFunc.imports("E_LIFNR")
            
             txtProveedorSAP.Text = MyFunc.imports("E_LIFNR")
            
            
             'MsgBox "El codigo del proveedor es: " & CodProveedor.Value
            
             'MsgBox "El codigo del proveedor es: " & CodProveedor.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
        
                txtMensaje.Text = txtMensaje.Text & MyFunc.Tables.Item("E_MESSAGE").Value(x, "TIPO") & "   " & MyFunc.Tables.Item("E_MESSAGE").Value(x, "MSG") & vbCrLf
           
                'MsgBox MyFunc.Tables.Item("E_MESSAGE").Value(x, "TIPO") & "   " & MyFunc.Tables.Item("E_MESSAGE").Value(x, "MSG")
                x = x + 1
               
            Next
   
            If Trim(txtProveedorSAP) <> "" Then
              'Graba Codigo Proveedor de SAP
              Call Inicializa_Parametros(1)
           
              Call Inicializa_Coneccion("sp_qry_sap")
              Call Setear_Parametros("Retorno", 2, 1, 0, "R")
              Call Setear_Parametros("i_operacion", 1, 1, "U", "I")
              Call Setear_Parametros("i_ruc", 1, 16, MyFunc.imports("E_LIFNR"), "I")
              Call Setear_Parametros("i_nombre", 1, 30, Trim(txtProveedor), "I")
              If Not Ejecutar_Consulta Then
                 Exit Sub
              End If
             
              Call Inicializa_Parametros(2)
           End If
        End If
    
        ' Terminar la sesion.
        r3.Connection.Logoff
     End If
End Sub