Excel VBA + GUI Script 批量更新SAP安全库存 - MM02

之前使用VBA写过几个GUI Script，这个是用来使用T-Code MM02自动更新SAP的安全库存，效率不高，但可以用来借鉴实现其它功能

下载链接：https://download.csdn.net/download/afterain/20260366

在Excel VBA新建模块后把以下代码复制进去

Option Explicit
Public SapGuiAuto, WScript, msgcol
Public objGui  As GuiApplication
Public objConn As GuiConnection
Public objSess As GuiSession
Public objSBar As GuiStatusbar
Public objSheet As Worksheet
Dim W_System
Dim iCtr As Integer
Const tcode = "MM02"


Function Attach_Session(iRow, Optional mysystem As String) As Boolean
Dim il, it
Dim W_conn, W_Sess

' Unless a system is provided (XXXYYY where XXX is SID and YYY client)
' get the system from the sheet (in this case it is in cell A8)
If mysystem = "" Then
    W_System = ActiveSheet.Cells(iRow, 1)
Else
    W_System = mysystem
End If

' If we are already connected to a session, exit do not try again
If W_System = "" Then
   Attach_Session = False
   Exit Function
End If

' If the session object is not nil, use that session (assume connected to the correct session)
If Not objSess Is Nothing Then
    If objSess.Info.SystemName & objSess.Info.Client = W_System Then
        Attach_Session = True
        Exit Function
    End If
End If

' If not connected to anything, set up the objects
If objGui Is Nothing Then
   Set SapGuiAuto = GetObject("SAPGUI")
   Set objGui = SapGuiAuto.GetScriptingEngine
End If

' Cycle through the open SAP GUI sessions and check which is in the same system running the matching transaction
For il = 0 To objGui.Children.Count - 1
    Set W_conn = objGui.Children(il + 0)
    For it = 0 To W_conn.Children.Count - 1
        Set W_Sess = W_conn.Children(it + 0)
        If W_Sess.Info.SystemName & W_Sess.Info.Client = W_System And W_Sess.Info.Transaction = tcode Then
            Set objConn = objGui.Children(il + 0)
            Set objSess = objConn.Children(it + 0)
            Exit For
        End If
    Next
Next

' If nothing is found, display and error message
If objSess Is Nothing Then
   MsgBox "No active session to system " + W_System + " with transaction " + tcode + ", or scripting is not enabled.", vbCritical + vbOKOnly
   Attach_Session = False
   Exit Function
End If

' Turn on scripting
If IsObject(WScript) Then
   WScript.ConnectObject objSess, "on"
   WScript.ConnectObject objGui, "on"
End If

' Maximize the window of the connected session
Set objSBar = objSess.FindById("wnd[0]/sbar")
objSess.FindById("wnd[0]").Maximize
Attach_Session = True


End Function

Public Sub StartProcessing()

Dim W_Obj1, W_Obj2, W_Obj3, W_Obj4, iRow
Dim W_Func
Dim W_Src_Ord
Dim W_Ret As Boolean
Dim itemcount As Integer
Dim itemmax As Integer
Const startrow As Integer = 11 'First row with actual data

Set objSheet = ActiveWorkbook.ActiveSheet
' Connect to a system stored in cell A8
W_Ret = Attach_Session(8)
If Not W_Ret Then
    MsgBox "Not connected to client"
    GoTo MyEnd
End If

itemcount = 0
itemmax = 0

' Determine the number of items to be processed: where the status is zero
For iRow = startrow To objSheet.UsedRange.Rows.Count
    If objSheet.Cells(iRow, 3) = "0" Then
        itemmax = itemmax + 1
    End If
Next
' Update the counter in cell A9
objSheet.Cells(9, 1) = itemcount & "/" & itemmax

' Cycle through the rows with status 0 and call the ProcessRow function to process them
For iRow = startrow To objSheet.UsedRange.Rows.Count
    If objSheet.Cells(iRow, 3) = "0" Then
        Call ProcessRow(iRow)
        itemcount = itemcount + 1
        objSheet.Cells(9, 1) = itemcount & "/" & itemmax
    End If
Next
           

MyEnd:
' destory the objects, free up memory
    Set objSess = Nothing
    Set objGui = Nothing
    Set SapGuiAuto = Nothing
    
    MsgBox "Script completed.", vbInformation + vbOKOnly
       
End Sub

Function ProcessRow(iRow)
Dim W_MaterialNO, W_SafetyStock
Dim lineitems As Long
Dim W_Plant As String
Dim iPage As Integer
Dim iChildrenCount As Integer
Dim iAbsoluteRow As Integer
Dim bl_Selected As Boolean

iAbsoluteRow = 0
bl_Selected = False

' Set the line status to "processing..."
objSheet.Cells(iRow, 3) = 1

'Plant
W_Plant = objSheet.Cells(9, 5)

'Material NO

W_MaterialNO = objSheet.Cells(iRow, 1)


'Safety Stock
If objSheet.Cells(iRow, 2) <> "" Then
    W_SafetyStock = objSheet.Cells(iRow, 2)
Else
    W_SafetyStock = ""
End If

' Set error handling to the below code where we can capture if a line had failed in the GUI script
On Error GoTo myerr

' SAP GUI Script starts here


objSess.FindById("wnd[0]").Maximize
objSess.FindById("wnd[0]/tbar[0]/okcd").Text = "/nmm02"
objSess.FindById("wnd[0]/tbar[0]/btn[0]").press
objSess.FindById("wnd[0]/usr/ctxtRMMG1-MATNR").Text = W_MaterialNO
objSess.FindById("wnd[0]/tbar[1]/btn[5]").press
objSess.FindById("wnd[1]/tbar[0]/btn[19]").press

'In order to search the target View, need find if need scroll down page
For iPage = 0 To objSess.FindById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").VerticalScrollbar.Maximum Step objSess.FindById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").VerticalScrollbar.PageSize
    
    'Search the view
    For iChildrenCount = 0 To objSess.FindById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").Children.Count - 1

        'Choose target view if it's been found
        If objSess.FindById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").GetAbsoluteRow(iAbsoluteRow).Item(0).Text = "MRP 2" Then
            Debug.Print "iAbsoluteRow=" & iAbsoluteRow
            Debug.Print objSess.FindById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").GetAbsoluteRow(iAbsoluteRow).Item(0).Text
            objSess.FindById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").GetAbsoluteRow(iAbsoluteRow).Selected = True
            bl_Selected = True
            Exit For
        End If
        'Calculate the absolute row
        iAbsoluteRow = iAbsoluteRow + 1
    Next iChildrenCount
    If bl_Selected = True Then
        Exit For
    End If
    objSess.FindById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").VerticalScrollbar.Position = objSess.FindById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").VerticalScrollbar.Position + objSess.FindById("wnd[1]/usr/tblSAPLMGMMTC_VIEW").VerticalScrollbar.PageSize
Next iPage

objSess.FindById("wnd[1]/tbar[0]/btn[0]").press
objSess.FindById("wnd[1]/usr/ctxtRMMG1-WERKS").Text = W_Plant
objSess.FindById("wnd[1]/usr/ctxtRMMG1-LGORT").Text = ""
objSess.FindById("wnd[1]/tbar[0]/btn[0]").press

'Set target value: safety stock
objSess.FindById("wnd[0]/usr/tabsTABSPR1/tabpSP16/ssubTABFRA1:SAPLMGMM:2000/subSUB4:SAPLMGD1:2486/txtMARC-EISBE").Text = W_SafetyStock

'Press save button
objSess.FindById("wnd[0]/tbar[0]/btn[11]").press

'In case warning message, send "Enter" key until no warning message
Do While objSBar.MessageType = "W"
    objSess.FindById("wnd[0]").sendVKey 0
Loop

' Gets the message from the status bar and save it in column B
objSheet.Cells(iRow, 5) = objSBar.Text

' Update the Status to "Completed" and exit
objSheet.Cells(iRow, 3) = 2
Exit Function

myerr:
' Update the status to "Error"
objSheet.Cells(iRow, 3) = 3
End Function

在Excel增加按钮并将StartProcessing放入其中

Private Sub CommandButton1_Click()
StartProcessing
End Sub