在Excel VBA中禁用SAP登录弹出窗口

Question

我有一个VBA代码,有助于登录SAP.代码工作正常但我在建立连接时收到警告弹出窗口.

我需要绕过或禁用此警告弹出窗口.我写了代码,但它没有用.请帮助

Sub code1()
If Not IsObject(SAPguiApp) Then
    Set SAPguiApp = CreateObject("Sapgui.ScriptingCtrl.1")
End If

If Not IsObject(Connection) Then
    Set Connection = SAPguiApp.OpenConnection("********", True)
End If

If Not IsObject(Session) Then
    Set Session = Connection.Children(0)
End If
If Session.ActiveWindow.Name = "wnd[1]" Then
    If Session.findbyid("wnd[1]").Text Like "A script*" Then Session.findbyid("wnd[0]/usr/btnSPOP-OPTION1").press
End If

Session.findbyid("wnd[0]/usr/txtRSYST-MANDT").Text = "103"
Session.findbyid("wnd[0]/usr/txtRSYST-BNAME").Text = "*****"
Session.findbyid("wnd[0]/usr/txtRSYST-LANGU").SetFocus
Session.findbyid("wnd[0]/usr/txtRSYST-LANGU").caretPosition = 2
Session.findbyid("wnd[0]").sendVKey 0

Session.findbyid("wnd[0]/tbar[0]/okcd").Text = "/nsu01"
Session.findbyid("wnd[0]").sendVKey 0
Session.findbyid("wnd[0]").maximize

End Sub

请注意:我知道可以在SAP GUI中禁用此弹出窗口但不支持这样做,因为它可能会在将来导致安全威胁.请通过以下代码帮助建议:

如果Session.ActiveWindow.Name ="wnd 1 "那么如果Session.findbyid("wnd 1 ").Text如"A script*"Then Session.findbyid("wnd [0]/usr/btnSPOP-OPTION1").按万一

Answer 1

这些是注册表中的设置,你可以像你想要的那样关闭和打开我有一个类clsSapgui

Option Explicit
Const mRegNameBase = "HKEY_CURRENT_USER\Software\SAP\SAPGUI Front\SAP Frontend Server\Security\"
Const mUserScripting = "UserScripting"
Const mWarnOnAttach = "WarnOnAttach"
Const mWarnOnConnection = "WarnOnConnection"
Const mSecurityLevel = "SecurityLevel"
Dim mRegKey As New clsRegistry

Property Get UserScripting() As Boolean
    UserScripting = ReadRegKey(mUserScripting)
End Property

Property Let UserScripting(newVal As Boolean)
    WriteRegKey mUserScripting, CBoolToVal(newVal)
End Property

Property Get WarnOnAttach() As Boolean
    WarnOnAttach = ReadRegKey(mWarnOnAttach)
End Property

Property Let WarnOnAttach(newVal As Boolean)
    WriteRegKey mWarnOnAttach, CBoolToVal(newVal)
End Property

Property Get WarnOnConnection() As Boolean
    WarnOnConnection = ReadRegKey(mWarnOnConnection)
End Property

Property Let WarnOnConnection(newVal As Boolean)
    WriteRegKey mWarnOnConnection, CBoolToVal(newVal)
End Property
Property Get SecurityLevel() As Boolean
    SecurityLevel = ReadRegKey(mSecurityLevel)
End Property

Property Let SecurityLevel(newVal As Boolean)
    WriteRegKey mSecurityLevel, CBoolToVal(newVal)
End Property
Private Function CBoolToVal(bVal As Boolean) As Byte
    If bVal Then
        CBoolToVal = 1
    Else
        CBoolToVal = 0
    End If
End Function

Private Function ReadRegKey(sRegValue As String) As String

    Dim sRegName As String

On Error GoTo NoRegkey

    sRegName = mRegNameBase & sRegValue
    ReadRegKey = mRegKey.ReadRegKey(sRegName)
    Exit Function

NoRegkey:
    ReadRegKey = 0

End Function

Private Function WriteRegKey(sRegKey As String, ByVal sRegValue As String) As Boolean

    Dim sRegName As String

On Error GoTo NoRegkey

    sRegName = mRegNameBase & sRegKey
    WriteRegKey = mRegKey.WriteRegKey(sRegName, sRegValue, "REG_DWORD")
    Exit Function

NoRegkey:
    WriteRegKey = False

End Function

然后你可以完全关闭警告

Sub Silence()

    Dim mySapGui As New clsSapGui

    With mySapGui
        .UserScripting = True
        .SecurityLevel = False
        .WarnOnAttach = False
        .WarnOnConnection = False
    End With

End Sub

然后再打开它们

    Sub Show_Warnings()

        Dim mySapGui As New clsSapGui

        With mySapGui
            .UserScripting = True
            .SecurityLevel = True
            .WarnOnAttach = True
            .WarnOnConnection = True
        End With

End Sub

如果你愿意,你当然可以在课堂上添加更新的方法

类clsRegistry看起来像那样

Option Explicit

Function ReadRegKey(RegKey As String) As Variant

Dim wsh As Object

    Set wsh = CreateObject("WScript.Shell")

    On Error GoTo NoRegkey

    ReadRegKey = wsh.regread(RegKey)

    Set wsh = Nothing
    Exit Function

NoRegkey:
    ReadRegKey = ""

End Function

Function DeleteRegKey(RegKey As String) As Boolean
' http://msdn.microsoft.com/en-us/library/yfdfhz1b(v=vs.84).aspx
Dim wsh As Object

   Set wsh = CreateObject("WScript.Shell")

   On Error GoTo NoRegkey

   wsh.RegDelete RegKey
   DeleteRegKey = True
   Set wsh = Nothing
   Exit Function

NoRegkey:
    DeleteRegKey = False

End Function


Function WriteRegKey(RegName As String, RegValue As Variant, RegType As String) As Boolean
' http://msdn.microsoft.com/en-us/library/yfdfhz1b(v=vs.84).aspx
Dim wsh As Object

   Set wsh = CreateObject("WScript.Shell")

   On Error GoTo NoRegkey

   wsh.RegWrite RegName, RegValue, RegType
   WriteRegKey = True
   Set wsh = Nothing
   Exit Function

NoRegkey:
    WriteRegKey = False

End Function