|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|