×

[PR]この広告は3ヶ月以上更新がないため表示されています。
ホームページを更新後24時間以内に表示されなくなります。




Sapass

 Simplify SAP R/3 development with Excel VBA/VB RFC  
Home> Design>Design/Code of IdocProcessor



Index

Design/Code of IdocProcessor

Here in this section, explain the design and function of IdocProcessor.
IdocProcessor contains following class, module and forms.
Class
Idoc
Module
IdocMan
Forms
IdocField
IdocHelp
IdocForm

06-Nov-2005


1. Idoc class - General

Class: Idoc contains 5 properties with 2 methods. Basically the design of the class is capsuled and no reference to other modules.
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1 'True
END
Attribute VB_Name = "Idoc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public DocNum As String
Public ControlRec As Object
Public Segments As Object
Public Sconn As Object 'Source connection
Public Tconn As Object 'Target connection

Function GetIdoc(Optional strErrMsg As String) As Long

Dim objRfcFunc As Object
Dim objDocNum As Object
Dim objDocControl As Object
Dim objDocContainer As Object
Dim objSubContainer As Object
Dim objField As Object
Dim lngIdx As Long
Dim strFunc As String

GetIdoc = vbError

'1. Open Idoc for read
strFunc = "EDI_DOCUMENT_OPEN_FOR_READ"
Set objRfcFunc = Sconn.Add(strFunc)
Set objDocNum = objRfcFunc.exports("DOCUMENT_NUMBER")
Set objDocControl = objRfcFunc.imports("IDOC_CONTROL")
objDocNum.Value = DocNum
If objRfcFunc.call = False Then
   strErrMsg = "Error in " & strFunc & " -" & objRfcFunc.Exception
   GoTo EXITFUNCTION
End If

'2. Get segment information
strFunc = "EDI_SEGMENTS_GET_ALL"
Set objRfcFunc = Sconn.Add(strFunc)
Set objDocNum = objRfcFunc.exports("DOCUMENT_NUMBER")
Set objDocContainer = objRfcFunc.tables("IDOC_CONTAINERS")
objDocNum.Value = DocNum
If objRfcFunc.call = False Then
   strErrMsg = "Error in " & strFunc & " - " & objRfcFunc.Exception
   GoTo EXITFUNCTION
End If
Set ControlRec = objDocControl

'3. Pass container to segment
Set Segments = objDocContainer

GetIdoc = vbOK

EXITFUNCTION:

End Function

Function PutIdoc(Optional strErrMsg As String) As Long

Dim objRfcFunc As Object
Dim objDocControl As Object
Dim objSegment As Object
Dim objDocIdent As Object
Dim objDocContainer As Object
Dim lngIdx As Long
Dim strFunc As String

PutIdoc = vbError

'1. Open Idoc for create
strFunc = "EDI_DOCUMENT_OPEN_FOR_CREATE"
Set objRfcFunc = Tconn.Add(strFunc)
Set objDocControl = objRfcFunc.exports("IDOC_CONTROL")
Set objDocIdent = objRfcFunc.imports("IDENTIFIER")
For lngIdx = 1 To objDocControl.ColumnCount
   If Not (objDocControl.ColumnName(lngIdx) = "MANDT" Or _
           objDocControl.ColumnName(lngIdx) = "DOCNUM" Or _
           objDocControl.ColumnName(lngIdx) = "DOCREL" Or _
           objDocControl.ColumnName(lngIdx) Like "*DAT" Or _
           objDocControl.ColumnName(lngIdx) Like "*TIM" Or _
           objDocControl.ColumnName(lngIdx) = "SERIAL" Or _
           objDocControl.ColumnName(lngIdx) = "RCVPOR") Then

      objDocControl(objDocControl.ColumnName(lngIdx)) = ControlRec(objDocControl.ColumnName(lngIdx))
   End If
   DoEvents
Next

'For lngIdx = 1 To objDocControl.ColumnCount: Debug.Print "[" & objDocControl.ColumnName(lngIdx) & "] = " & objDocControl(objDocControl.ColumnName(lngIdx)): Next

If objRfcFunc.call = False Then
   strErrMsg = "Error in " & strFunc & " - " & objRfcFunc.Exception
   GoTo EXITFUNCTION
End If
DocNum = objDocIdent.Value

'2. Write segment information
strFunc = "EDI_SEGMENT_ADD_NEXT"
Set objRfcFunc = Tconn.Add(strFunc)
Set objDocIdent = objRfcFunc.exports("IDENTIFIER")
Set objDocContainer = objRfcFunc.exports("IDOC_CONTAINER")
For Each objSegment In Segments.Rows
   For lngIdx = 1 To objDocContainer.ColumnCount
      objDocContainer(objDocContainer.ColumnName(lngIdx)) = objSegment(objDocContainer.ColumnName(lngIdx))
      DoEvents
   Next
   objDocContainer("DOCNUM") = DocNum
   objDocIdent.Value = DocNum
   If objRfcFunc.call = False Then
      strErrMsg = "Error in " & strFunc & " (" & objSegment.SegNam & ") - " & objRfcFunc.Exception
      GoTo EXITFUNCTION
   End If
   DoEvents
Next

'3. Close
strFunc = "EDI_DOCUMENT_CLOSE_CREATE"
Set objRfcFunc = Tconn.Add(strFunc)
Set objDocIdent = objRfcFunc.exports("IDENTIFIER")
Set objDocControl = objRfcFunc.imports("IDOC_CONTROL")
objDocIdent.Value = DocNum

If objRfcFunc.call = False Then
   strErrMsg = "Error in " & strFunc & " - " & objRfcFunc.Exception
   GoTo EXITFUNCTION
End If

PutIdoc = vbOK

EXITFUNCTION:

End Function




06-Nov-2005


1-1. Idoc class - Properties

Propeties
The class contains 5 properties.

DocNum
DocNum is an input parameter for the class. This string parameter will have Idoc number when the class gets Idoc from SAP or put Idoc to SAP. This is a key field and mandatory for class.
ControlRec
This parameter contains Idoc control record structure object. The format of this object needs to have EDIDC structure object.
Segments
This object will contain the EDID4 structure table object. Unlike the ControlRec parameter has single record in it, this Segments object will contain multiple records enough to be processed as Idoc.
Sconn
Connection object for source system.The object must be Connection object created from Logon control or function control. This connection will be used when the class gets data from SAP.
Tconn
On the contrary to Sconn object, this is for target system.This must be Connection object created from Logon control or function control. This connection will be used when the class puts data to SAP.

06-Nov-2005


1-2. Idoc class - Methods

Methods
The class contains 2 methods.

GetIdoc
Once the properties - DocNum and Sconn - is supplied, this GetIdoc function can be used. After the call of the method, you can get Idoc control record to ControlRec and at the same time Segments information is filled with Idoc segment data. This method is realized with function module: EDI_DOCUMENT_OPEN_FOR_READ and EDI_SEGMENTS_GET_ALL.
PutIdoc
To utilize this method, you have to supply ControlRec, Segments and Tconn information. You can set DocNum but when this method tries to put the Idoc to SAP, the value will be ignored. The function module utilizes function module: EDI_DOCUMENT_OPEN_FOR_CREATE, EDI_SEGMENT_ADD_NEXT and EDI_DOCUMENT_CLOSE_CREATE.

06-Nov-2005


2. IdocMan module - General

Module: Idoc contains 8 sub/functions.
Attribute VB_Name = "IdocMan"
Option Explicit
Option Private Module

Sub Auto_open()

Dim objBarControl As Object
Dim myMenu As Object
Dim myMenuBar As Object
Dim mySubMenu As Object
Dim ctrl1 As Object

On Error Resume Next
'Right click
If CommandBars("Cell").Controls("Edit Segment").Caption = "" Then
   Set objBarControl = CommandBars.Item("Cell").Controls.Add
       objBarControl.Caption = "Edit Segment"
       objBarControl.OnAction = "EditSegment"
       objBarControl.begingroup = True
End If

'Menu
Set myMenuBar = CommandBars.Add(Name:="Sapass", Position:=1, temporary:=True)
Set myMenu = myMenuBar.Controls.Add(Type:=10, temporary:=True)
    myMenu.Caption = "Sapass"
Set myMenuBar = CommandBars.Item("Sapass")
    myMenuBar.Visible = True
    myMenuBar.Protection = 16
Set myMenu = myMenuBar.Controls.Item("Sapass")
If myMenu.Controls.Item("IDOC").Caption = "" Then
   Set mySubMenu = myMenu.Controls.Add(Type:=10)
       mySubMenu.Caption = "IDOC"
       mySubMenu.TooltipText = "Process IDOC"
       mySubMenu.Style = 2 'msoButtonCaption
End If
Set mySubMenu = myMenu.Controls.Item("IDOC")
            
If mySubMenu.Controls.Item("Process...").Caption = "" Then
   Set ctrl1 = mySubMenu.Controls.Add(Type:=1)
       ctrl1.Caption = "Process..."
       ctrl1.TooltipText = "Process..."
       ctrl1.Style = 2
       ctrl1.OnAction = "Main"
End If

If mySubMenu.Controls.Item("Help...").Caption = "" Then
   Set ctrl1 = mySubMenu.Controls.Add(Type:=1)
       ctrl1.Caption = "Help..."
       ctrl1.TooltipText = "Help..."
       ctrl1.Style = 2
       ctrl1.OnAction = "OpenHelp"
       ctrl1.begingroup = True
End If

If mySubMenu.Controls.Item("Exit...").Caption = "" Then
   Set ctrl1 = mySubMenu.Controls.Add(Type:=1)
       ctrl1.Caption = "Exit..."
       ctrl1.TooltipText = "Exit..."
       ctrl1.Style = 2
       ctrl1.OnAction = "ExitIdoc"
       ctrl1.begingroup = True
End If

On Error GoTo 0

End Sub

Sub Auto_close()

On Error Resume Next
'Right click
CommandBars("Cell").Controls("Edit Segment").Delete
'Sapass
CommandBars("Sapass").Controls("Sapass").Controls("IDOC").Delete
If CommandBars("Sapass").Controls("Sapass").Controls.Count = 0 Then
   CommandBars("Sapass").Delete
End If
On Error GoTo 0

End Sub

Private Sub EditSegment()
Dim lngIdx As Long
Dim lngRow As Long
lngRow = ActiveCell.Row
If ActiveCell.Parent.Cells(lngRow, 1) = "EDIDD" Then
   IdocField.ShowStructure strSegName:=ActiveCell.Parent.Cells(lngRow, 5)
End If
End Sub

Sub Main()

Dim lngResult As Long
Dim objIdoc As Idoc
Dim objSrcConn As Object
Dim objTgtConn As Object
Dim lngSRow As Long
Dim objSrcParent As Object
Dim lngTRow As Long
Dim objTgtParent As Object
Dim lngIdx As Long
Dim objSegment As Object
Dim varSrcNum As Variant
Dim lngScell As Long
Dim strDocType As String
Dim strPrvType As String

IdocForm.Update
IdocForm.Show

If IdocForm.OkCancel = vbCancel Then Exit Sub

Select Case IdocForm.lngProcessType
   Case 1 'Download
      'Target start row
      Set objTgtParent = Range(IdocForm.TgtRefEdit).Parent
      lngTRow = Range(IdocForm.TgtRefEdit).Row
      'Loop and process
      For Each varSrcNum In Range(IdocForm.SrcRefEdit)
         Set objIdoc = New Idoc
         Set objIdoc.Sconn = IdocForm.objSrcConn
         objIdoc.DocNum = CStr(varSrcNum)
         lngResult = objIdoc.GetIdoc
         If lngResult = vbError Then varSrcNum.Cells.Font.Color = vbRed: GoTo NEXTLOOP1
         'Fill out ControlRec
         objTgtParent.Cells(lngTRow, 1) = "EDIDC"
         For lngIdx = 1 To objIdoc.ControlRec.ColumnCount
            objTgtParent.Cells(lngTRow, lngIdx + 1) = objIdoc.ControlRec(lngIdx)
            DoEvents
         Next
         'Fill out DataRec
         For Each objSegment In objIdoc.Segments.Rows
            lngTRow = lngTRow + 1
            objTgtParent.Cells(lngTRow, 1) = "EDIDD"
            For lngIdx = 1 To objIdoc.Segments.ColumnCount
               objTgtParent.Cells(lngTRow, lngIdx + 1) = objSegment(objIdoc.Segments.ColumnName(lngIdx))
            Next
            DoEvents
         Next
         lngTRow = lngTRow + 1
NEXTLOOP1:
         DoEvents
      Next
      Set objIdoc = Nothing
         
   Case 2 'Copy
      Set objTgtParent = Range(IdocForm.SrcRefEdit).Parent
      lngTRow = Range(IdocForm.SrcRefEdit).Row
      'Loop and process
      For Each varSrcNum In Range(IdocForm.SrcRefEdit)
         Set objIdoc = New Idoc
         Set objIdoc.Sconn = IdocForm.objSrcConn
         objIdoc.DocNum = CStr(varSrcNum)
         'Get Idoc
         lngResult = objIdoc.GetIdoc
         'Put Idoc if there is no errors
         If lngResult <> vbError Then
            Set objIdoc.Tconn = IdocForm.objTgtConn
            lngResult = objIdoc.PutIdoc
         End If
         DoEvents
      Next
   
   Case 3 'Upload
      'Loop and process
      strDocType = ""
      strPrvType = ""
      Set objTgtParent = Range(IdocForm.TgtRefEdit).Parent
      For Each varSrcNum In Range(IdocForm.TgtRefEdit)
         lngTRow = varSrcNum.Row
         strDocType = objTgtParent.Cells(varSrcNum.Row, 1)
         If strDocType = "EDIDC" Then
            'Process up to here
            If strPrvType <> "" Then
               lngResult = objIdoc.PutIdoc
               If lngResult = vbError Then varSrcNum.Cells.Font.Color = vbRed: GoTo NEXTLOOP3
            End If
            'Process next
            Set objIdoc = New Idoc
            Set objIdoc.Tconn = IdocForm.objTgtConn
            Set objIdoc.Sconn = IdocForm.objSrcConn
            Set objIdoc.Segments = New Collection
            'Control record
            Set objIdoc.ControlRec = CreateR3Structure(objIdoc.Tconn, "EDIDC", "IDOC_CONTROL")
            '
            For lngIdx = 1 To objIdoc.ControlRec.ColumnCount
               objIdoc.ControlRec(objIdoc.ControlRec.ColumnName(lngIdx)) = objTgtParent.Cells(lngTRow, lngIdx + 1).Value
               DoEvents
            Next
            '
            objIdoc.DocNum = objIdoc.ControlRec("DOCNUM")
            'Segment
            Set objIdoc.Segments = CreateR3Table(objIdoc.Tconn, "EDIDD", "IDOC_SEGMENT")
            '
            strDocType = objTgtParent.Cells(lngTRow, 3)
            strPrvType = strDocType
         End If
         '
         'Fill out ControlRec
         If objTgtParent.Cells(lngTRow, 1) = "EDIDD" Then
            objIdoc.Segments.Rows.Add
            For lngIdx = 1 To objIdoc.Segments.ColumnCount
               objIdoc.Segments(objIdoc.Segments.RowCount, objIdoc.Segments.ColumnName(lngIdx)) = objTgtParent.Cells(lngTRow, lngIdx + 1).Value
            Next
         End If
NEXTLOOP3:
         DoEvents
      Next
      lngResult = objIdoc.PutIdoc
   End Select
End Sub

Sub OpenHelp()
IdocHelp.Show
End Sub

Sub ExitIdoc()
Dim lngResult As Long
lngResult = MsgBox("Do you want to close?", vbYesNo)
If lngResult = vbNo Then Exit Sub
Auto_close
ThisWorkbook.Close
End Sub

Public Function CreateR3Structure(objConn As Object, strRefStruct As String, strParmName As String) As Object
Dim objTable As Object
Dim lngResult As Long

'Initialize bdctable
Set objTable = CreateObject("SAP.TableFactory.1")
Set CreateR3Structure = objTable.NewStructure
'For export bdctable
lngResult = CreateR3Structure.CreateFromR3Repository(objConn.Connection, strRefStruct, strParmName)
Set objTable = Nothing

End Function

Public Function CreateR3Table(objConn As Object, strRefStruct As String, strParmName As String) As Object
Dim objTable As Object
Dim lngResult As Long

'Initialize bdctable
Set objTable = CreateObject("SAP.TableFactory.1")
Set CreateR3Table = objTable.NewTable
'For export bdctable
lngResult = CreateR3Table.CreateFromR3Repository(objConn.Connection, strRefStruct, strParmName)
Set objTable = Nothing

End Function




06-Nov-2005


2-1. IdocMan module - Sub procedures

Sub procedures

Auto_Open
Auto_open procedure creates additional menu bar in Excel.
Auto_Close
Auto_close removes the menu created by Auto_Open procedure.
Main
From this procedure, IdocForm is called and displayed. Depending on the option specified in the form, different function will be called. Each function will refer to the RefEdit object (Range object) specified in the form and process accordingly with GetIdoc (Read), PutIdoc(Write) or both (Copy).
Edit_Segment
Edit_Segment is a procddure triggered when the cell which contains Idoc is double clicked. From this segment, form: IdocField will be called and allowed for editting.
OpenHelp
Shows Help form.
ExitIdoc
Exits the macro and close the Add-in.

06-Nov-2005


2-2. IdocMan module - Functions

Functions

CreateR3Structure
This function receives parameters -
objConn - Connection object generated from Function control or logon control.
strRefStruct - Reference structure in SAP. For Idoc control, this will be EDIDC.
strParmName - This has to have value of input parmeter for function module. e.g. IDOC_CONTROL.
CreateR3Table
This function receives parameters -
objConn - Connection object generated from Function control or logon control.
strRefStruct - Reference structure in SAP. For Idoc control, this will be EDIDD.
strParmName - This has to have value of input parmeter for function module. e.g. IDOC_SEGMENT.

06-Nov-2005


3. IdocForm - General

Form: IdocForm contains contains 4 properties and more than 10 sub procedures and functions. Basically this controls user interface.
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} IdocForm
   Caption = "Idoc Processor"
   ClientHeight = 3315
   ClientLeft = 45
   ClientTop = 330
   ClientWidth = 6360
   OleObjectBlob = "IdocForm.frx":0000
   StartUpPosition = 1 'CenterOwner
End
Attribute VB_Name = "IdocForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public OkCancel As Long
Public objSrcConn As Object
Public objTgtConn As Object
Public lngProcessType As Long

Private Sub CancelButton_Click()
Hide
lngProcessType = 0
OkCancel = vbCancel
End Sub

Private Sub DownloadOption_Change()
If objSrcConn Is Nothing Then
    IdocDisabled
    RangeDisabled
    Exit Sub
End If
If DownloadOption.Value = True Then
   IdocEnabled
   RangeEnabled
End If
End Sub

Private Sub CopyOption_Change()
If objSrcConn Is Nothing And objTgtConn Is Nothing Then
   IdocDisabled
   RangeDisabled
   Exit Sub
End If
If CopyOption.Value = True Then
   IdocEnabled
   RangeDisabled
End If
End Sub

Private Sub UploadOption_Change()
If objTgtConn Is Nothing And (objSrcConn Is Nothing Or DownloadOption.Value <> True) Then
   RangeDisabled
   Exit Sub
End If
If UploadOption.Value = True Then
   IdocDisabled
   RangeEnabled
End If
End Sub

Private Sub OkButton_Click()
Dim strErrMsg As String
lngProcessType = 0
If DownloadOption.Value = True Then
   lngProcessType = 1
   strErrMsg = CheckIdocNum()
   strErrMsg = CheckRange()
ElseIf CopyOption.Value = True Then
   lngProcessType = 2
   strErrMsg = CheckIdocNum()
ElseIf UploadOption.Value = True Then
   lngProcessType = 3
   strErrMsg = CheckRange()
Else
   strErrMsg = "No option is selected"
End If

If strErrMsg <> "" Then MsgBox strErrMsg: Exit Sub

Hide
OkCancel = vbOK
End Sub

Public Function SapLogOn(nodia As Boolean, SapConn As Object) As Long

Dim logonDialog As Long
Dim checkProd As Long
      
On Error Resume Next
If SapConn.Connection.IsConnected = 1 Then
   If Err = 0 Then
      SapLogOn = MsgBox("Already logged on to " & SapConn.Connection.SystemId & Chr(13) & "Use current logon?", vbYesNoCancel)
   Else
      SapLogOn = vbNo
   End If
   On Error GoTo 0
   If SapLogOn = vbYes Then
      Exit Function
   ElseIf SapLogOn = vbCancel Then
      SapLogOn = vbCancel
      Exit Function
   End If
End If

SapLogOn = vbOK

'SAP Connenction
Set SapConn = Nothing

'Preparation for connect
Set SapConn = CreateObject("SAP.Functions")

'Connection window pop-up and check
If SapConn.Connection.Logon(0, nodia) <> True Then
   SapLogOn = vbCancel
   Exit Function
End If

End Function

Function SapLogOff(SapConn As Object) As Long

SapLogOff = vbCancel

'SAP Disconnection
On Error GoTo EXITLOGOFF
SapConn.Connection.LogOff
'
Set SapConn = Nothing
SapLogOff = vbOK

EXITLOGOFF:
End Function

Private Sub SourceLogon_Click()
Dim lngResult As Long
If Not objSrcConn Is Nothing Then
   lngResult = SapLogOff(objSrcConn)
Else
   lngResult = SapLogOn(False, objSrcConn)
End If
Update

End Sub

Private Sub TargetLogon_Click()
Dim lngResult As Long
If Not objTgtConn Is Nothing Then
   lngResult = SapLogOff(objTgtConn)
Else
   lngResult = SapLogOn(False, objTgtConn)
End If
Update
End Sub

Public Sub Update()

If objSrcConn Is Nothing And objTgtConn Is Nothing Then
   ProcessFrame.Enabled = False
   DownloadOption.Enabled = False
   CopyOption.Enabled = False
   UploadOption.Enabled = False
End If

'Check if the source is connected
If Not objSrcConn Is Nothing Then
   If objSrcConn.Connection.IsConnected <> 1 Then
      Set objSrcConn = Nothing
   End If
End If

'Check if the Target is connected
If Not objTgtConn Is Nothing Then
   If objTgtConn.Connection.IsConnected <> 1 Then
      Set objTgtConn = Nothing
   End If
End If

If Not objSrcConn Is Nothing Then
   SourceText.Text = objSrcConn.Connection.SystemId
   SourceLogon.Caption = "Logoff"
   ProcessFrame.Enabled = True
   DownloadOption.Enabled = True
   SourceText.Enabled = True
Else
   SourceText.Text = "Not connected"
   SourceLogon.Caption = "Logon"
   SourceText.Enabled = False
   DownloadOption.Enabled = False
   DownloadOption.Value = False
   CopyOption.Enabled = False
   CopyOption.Value = False
End If

If Not objTgtConn Is Nothing Then
   TargetText.Text = objTgtConn.Connection.SystemId
   TargetLogon.Caption = "Logoff"
   ProcessFrame.Enabled = True
   UploadOption.Enabled = True
   TargetText.Enabled = True
   If Not objSrcConn Is Nothing Then
      CopyOption.Enabled = True
   End If
Else
   TargetText.Text = "Not connected"
   TargetLogon.Caption = "Logon"
   TargetText.Enabled = False
   UploadOption.Enabled = False
   UploadOption.Value = False
   CopyOption.Enabled = False
   CopyOption.Value = False
End If

DownloadOption_Change
CopyOption_Change
UploadOption_Change

End Sub

Private Sub RangeEnabled()
RangeFrame.Enabled = True
RangeLabel.Enabled = True
TgtRefEdit.Enabled = True
TgtRefEdit.BackColor = vbHighlightText
End Sub
Private Sub RangeDisabled()
RangeFrame.Enabled = False
RangeLabel.Enabled = False
TgtRefEdit.Enabled = False
TgtRefEdit.BackColor = vbInactiveBorder
End Sub
Private Sub IdocEnabled()
IdocFrame.Enabled = True
SrcRefEdit.Enabled = True
IdocLabel.Enabled = True
SrcRefEdit.BackColor = vbHighlightText
End Sub
Private Sub IdocDisabled()
IdocFrame.Enabled = False
SrcRefEdit.Enabled = False
IdocLabel.Enabled = False
SrcRefEdit.BackColor = vbInactiveBorder
End Sub

Private Function CheckIdocNum() As String
CheckIdocNum = ""
If SrcRefEdit.Value = "" Then CheckIdocNum = "Idoc Number cnnot be blank": Exit Function
If Not IsNumeric(Range(SrcRefEdit.Value)(1).Value) Then CheckIdocNum = "Idoc number must be numeric"
End Function

Private Function CheckRange() As String
CheckRange = ""
If TgtRefEdit.Value = "" Then CheckRange = "Range cannot be blank": Exit Function
If IsError(TgtRefEdit.Value) Then CheckRange = "Range is invalid"
End Function



06-Nov-2005


3-1. IdocForm form - Properties

Properties

OkCancel
This parameter is to pass the OK/Cancel button press result to main module. vbOk or vbCancel is the possible value.
objSrcConn and objTgtConn
These are for keeping SAP connection object. objSrcConn is for source system and ObjTgtConn is for target system.
lngProcessType
This property is fo passing the process type - Download, Copy or Upload to main module. Download - 1, Copy - 2 and Upload - 3.

08-Nov-2005


3-2. IdocForm form - Sub procedures

Sub procedures

SapLogon
This function does logon to SAP using ActiveX object. Checks if there is any connection already established and make new connection if necessary.
SapLogoff
If there is a connection already, disconnect from SAP.
Others..
Basically any other functions are for controlling the events raised by the Idocform. E.g. change button view based on the SAP connection status or, enable/disable the buttons/ranges for users input.

08-Nov-2005


4. IdocField - General

Form: IdocForm contains contains 3 properties and more than 5 sub procedures and functions. This is an editor for updating Idoc segments. This form is called when the users double clicked the rows where the idoc segment is on.
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} IdocField
   Caption = "Segment Field"
   ClientHeight = 3810
   ClientLeft = 45
   ClientTop = 330
   ClientWidth = 7200
   OleObjectBlob = "IdocField.frx":0000
   StartUpPosition = 1 'CenterOwner
End
Attribute VB_Name = "IdocField"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public OkCancel As Long
Public FieldSets As New Collection
Public Sdata

Private Sub CancelButton_Click()
Hide
OkCancel = vbCancel
End Sub

Private Sub FieldList_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim strValue As String
Dim strSdata As String
If FieldList.ListIndex < 0 Then MsgBox "Select row first": Exit Sub
strValue = Application.InputBox("Change " & FieldList.List(FieldList.ListIndex, 0), , FieldList.List(FieldList.ListIndex, 2))
On Error Resume Next
If strValue = "False" Then Exit Sub
On Error GoTo 0

FieldList.List(FieldList.ListIndex, 2) = strValue

strSdata = Left(ActiveCell & Space(1024), 1024)
Mid(strSdata, FieldList.List(FieldList.ListIndex, 3) - 63, FieldList.List(FieldList.ListIndex, 4)) = strValue
Sdata = strSdata

End Sub

Private Sub OkButton_Click()
Hide
ActiveCell = Sdata
OkCancel = vbOK
End Sub

Public Sub ShowStructure(strSegName As String)
Dim objFields As Object
Dim objField As Object

On Error Resume Next
Set objFields = FieldSets(strSegName)
On Error GoTo 0

If objFields Is Nothing Then
   Set objFields = ReadSegmentStructure(strSegName)
End If

If objFields Is Nothing Then MsgBox "Segment definition not found": Exit Sub

SegmentText = strSegName
Sdata = ActiveCell
FieldList.Clear
'ReDim varArray(objFields.RowCount, 3)
For Each objField In objFields.Rows
   FieldList.AddItem
   FieldList.List(FieldList.ListCount - 1, 0) = objField("FIELDNAME")
   FieldList.List(FieldList.ListCount - 1, 1) = objField("DESCRP")
   FieldList.List(FieldList.ListCount - 1, 2) = Mid(Space(63) & ActiveCell, CLng(objField("BYTE_FIRST")), CLng(objField("EXTLEN")))
   FieldList.List(FieldList.ListCount - 1, 3) = objField("BYTE_FIRST")
   FieldList.List(FieldList.ListCount - 1, 4) = objField("EXTLEN")
Next

IdocField.Show

End Sub

Private Function ReadSegmentStructure(strSegName As String, Optional strRelease As String, Optional strErrMsg As String) As Object

Dim objRfcFunc As Object
Dim objFields As Object
Dim Exception As String
Dim objConn As Object
Dim lngResult As Long

If IdocForm.objTgtConn Is Nothing Then
   lngResult = IdocForm.SapLogOn(False, objConn)
   If lngResult <> vbOK Then Exit Function
   Set IdocForm.objTgtConn = objConn
End If

Set objConn = IdocForm.objTgtConn

strRelease = IIf(strRelease = "", objConn.Connection.SAPRelease, strRelease)
If Not objConn.SEGMENT_READ_COMPLETE(Exception, PI_SEGTYP:=strSegName, PI_RELEASE:=strRelease, PT_FIELDS:=objFields) Then
   strErrMsg = "Error in SEGMENT_READ_COMPLETE - " & Exception
   FieldSets.Add Nothing, strSegName
   GoTo EXITFUNCTION
End If
FieldSets.Add objFields, strSegName
Set ReadSegmentStructure = objFields
'objFields.FeeTble

EXITFUNCTION:

End Function




08-Nov-2005


4-1. IdocField form - Properties

Properties

OkCancel
This parameter is to pass the OK/Cancel button press result to main module. vbOk or vbCancel is the possible value.
Fieldsets
This is collection object to keep the SAP structure of the required segment. To get enough performance, the information is being kept as collection once the segment is processed.
Sdata
This is a string which keeps the updated value after the data is modified through this IdocFieldform.

09-Nov-2005


4-2. IdocField form - Sub procedures

Sub procedures

CancelButton_Click
Hide function and set OkCancel property to vbCancel and back to main module.
FieldList_DblClick
When the list box in the form is double clicked, show the contents of the selected line (string) in inputbox and allow users to modify the content. After user modified it, reflect the content to list box.
OkButton_Click
Similar to CancelButton_Click, hide the form and pass OkCancel property value to main module.
ShowStructure
Get the selected row of Excel sheet and split the string into the format of Idoc segment structure. Then populate the fields into listbox and show in the form.
ReadSegmentStructure
This function is called by ShowSetructure procedure. This function connects SAP and get Idoc segment structure information through function module: SEGMENT_READ_COMPLETE. Then the structure information will be returned to ShowStructure procedure.

10-Nov-2005


5. IdocHelp - General

Form: IdocHelp contains 2 simple procedures. This just shows form with Hyperlink text.
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} IdocHelp
   Caption = "Help"
   ClientHeight = 1155
   ClientLeft = 45
   ClientTop = 330
   ClientWidth = 4230
   OleObjectBlob = "IdocHelp.frx":0000
   StartUpPosition = 1 'CenterOwner
End
Attribute VB_Name = "IdocHelp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub OkButton_Click()
Unload Me
End Sub

Private Sub LinkLabel_Click()
On Error Resume Next
ActiveWorkbook.FollowHyperlink Address:="http://sapass.metro.client.jp", NewWindow:=True
On Error GoTo 0
Unload Me
End Sub




10-Nov-2005


5-1. IdocHelp form - Sub procedures

Sub procedures

OkButton_Click
Just unload the form.
LinkLabel_Click
Open link specified in the text if the hyper text is clicked.

10-Nov-2005