簡體   English   中英

在 Excel VBA 中禁用 SAP 登錄彈出窗口

[英]Disable SAP logon popup in Excel VBA

我有一個有助於登錄 SAP 的 VBA 代碼。 該代碼工作正常,但在建立連接時出現警告彈出窗口。

在此處輸入圖片說明

我需要繞過或禁用此警告彈出窗口。 我已經寫了代碼,但它不起作用。請幫忙

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 中禁用此彈出窗口,但不贊成這樣做,因為它可能會導致未來的安全威脅。 請在如下代碼的幫助下提出建議:

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

這些是注冊表中的設置,您可以根據需要關閉和打開它們我有一個類 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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM