Я пытаюсь переработать код из другой темы (ЗДЕСЬ) и ответ пользователя Storax под свои текущие нужды. Однако в приведенном примере значения имеют логический тип (1 и 0), тогда как в моем случае они должны быть строковыми (т. е. текстовыми).
Я хотел бы создать простой код, где:
*Примечание: начальное значение языка может отличаться от DE, например. ES, FR и т. д. или даже EN.
Почему? Потому что в другой подпрограмме хотелось бы вызвать (в самом начале) Sub_1 и Sub_2, затем шаги основной подпрограммы выполнить как обычно, и наконец (в самом конце) вызвать Sub_3, чтобы восстановить запомненное значение языка (т. е. константа, хранящаяся в Sub_1).
Другими словами, я хотел бы установить английский язык входа в SAP (независимо от того, какой другой язык выбран в данный момент), чтобы выполнить некоторые шаги в SAP для извлечения данных и, когда это будет сделано, сбросить язык входа в SAP обратно. до своего первоначального значения.
Модуль класса clsRegistry2
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
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
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
Модуль класса clsSapgui2
Option Explicit
Const mRegNameBase2 = "HKEY_CURRENT_USER\Software\SAP\General\"
Const mLanguage = "Language"
Dim mRegKey As New clsRegistry
Property Get Language() As String
UserScripting = ReadRegKey(mLanguage)
End Property
Property Let Language(newVal As String)
WriteRegKey mLanguage, 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 = mRegNameBase2 & 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 = mRegNameBase2 & sRegKey
WriteRegKey = mRegKey.WriteRegKey(sRegName, sRegValue, "REG_SZ")
Exit Function
NoRegkey:
WriteRegKey = "EN"
End Function
Модуль Z_SAP_Options
Sub Sub_2 ()
Dim mySapGui2 As New clsSapgui2
With mySapGui2
.Language = "EN"
End With
End Sub
Когда я запускаю подпрограмму, я получаю следующее сообщение об ошибке «Ошибка компиляции: несоответствие типа аргумента ByRef», выделение (newVal).
Property Let Language(newVal As String)
WriteRegKey mLanguage, CBoolToVal(newVal)
End Property
Опять же, это уже существующий код, который я пытался адаптировать. Я считаю, что тип следует изменить с Boolean на String (или другой). Я пока не смог написать Sub_1 и Sub_3. Извинения с моей стороны. Кодирование VBA для редактора реестра — это для меня совершенно новая территория.
Буду очень признателен, если кто-нибудь поможет мне в разрешении моего случая.
Без абстракций классов у меня это работает нормально:
'a key I made up since I don't have SAS
Const LANG_REG_KEY As String = "HKEY_CURRENT_USER\Environment\blah"
Sub Tester()
Debug.Print "Initial", GetLang()
Debug.Print "Changing...", SetLang("DE"), GetLang()
Debug.Print "Resetting...", SetLang("EN"), GetLang()
End Sub
'Read Language
Function GetLang() As String
GetLang = ReadRegKey(LANG_REG_KEY)
End Function
'Set Language
Function SetLang(lang As String) As Boolean
SetLang = WriteRegKey(LANG_REG_KEY, CVar(lang), "REG_SZ")
End Function
'Read a key - will return `Empty` if not found
Function ReadRegKey(RegKey As String) As Variant
With CreateObject("WScript.Shell")
On Error Resume Next
ReadRegKey = .regread(RegKey)
End With
End Function
'Write a key value and return `True` if successful
Function WriteRegKey(RegName As String, RegValue As Variant, _
RegType As String) As Boolean
With CreateObject("WScript.Shell")
On Error GoTo NoRegkey
.RegWrite RegName, RegValue, RegType
WriteRegKey = True
End With
NoRegkey: 'will return False by default...
End Function
Взгляните на расширенную версию класса ниже. Однако я не уверен, что это вам сильно поможет. Ключевым моментом является то, что вам всегда необходимо полностью перезапускать SAPGUI, чтобы изменения в реестре вступили в силу. Это означает, что вы должны закрыть каждый сеанс и перезапустить SAPLOGON.
Вы можете проверить это с помощью следующего кода
Sub testit()
Dim myGuiReg As New GuiReg
Debug.Print myGuiReg.Language
Dim savedUserLang As String
savedUserLang = myGuiReg.Language
myGuiReg.Language = "EN"
' do whatever is needed
' ATTENTION
' Restart of SAPGUI is neccessary otherwise
' changes do not have any effect
myGuiReg.Language = savedUserLang
End Sub
Нужны классы (извините, я их переименовал)
Класс ГуиРег
Option Explicit
' Enumeration for SecurityLevel
Enum guiLevel
Disabled = 0
Customized = 1
StrictDeny = 2
End Enum
' Enumeration for DefaultAction
Enum guiAction
Allow = 0
Ask = 1
Deny = 2
End Enum
' Only certain combinations with SecurtiyLevel are allowed resp. reasonable
' SecurityLevel DefaultAction
' 0 0 , 1 0, 1 1, 1 2, 2 2
Const mRegNameSecurity = "HKEY_CURRENT_USER\Software\SAP\SAPGUI Front\SAP Frontend Server\Security\"
Const mUserScripting = "UserScripting"
Const mWarnOnAttach = "WarnOnAttach"
Const mWarnOnConnection = "WarnOnConnection"
' 0 = Deactivated, 1 = Allow , 2 = rule based
Const mSecurityLevel = "SecurityLevel"
' Deafult Action
Const mDefaultAction = "DefaultAction"
Const mRegNameScripting = "HKEY_CURRENT_USER\Software\SAP\SAPGUI Front\SAP Frontend Server\Scripting\"
Const mShowNativeWinDlgs = "ShowNativeWinDlgs"
Const mRegNameLang = "HKEY_CURRENT_USER\Software\SAP\General\"
Const mLang = "Language"
Dim mRegKey As Registry
Property Get DefaultAction() As Byte
DefaultAction = ReadKey(mRegNameSecurity, mDefaultAction)
End Property
Property Let DefaultAction(nVal As Byte)
WriteKey mRegNameSecurity, mDefaultAction, nVal
End Property
Property Get ShowNativeWinDlgs() As Byte
ShowNativeWinDlgs = ReadKey(mRegNameScripting, mShowNativeWinDlgs)
End Property
Property Let ShowNativeWinDlgs(newVal As Byte)
WriteKey mRegNameScripting, mShowNativeWinDlgs, newVal
End Property
Property Get UserScripting() As Boolean
UserScripting = ReadKey(mRegNameSecurity, mUserScripting)
End Property
Property Let UserScripting(newVal As Boolean)
WriteKey mRegNameSecurity, mUserScripting, CBoolToVal(newVal)
End Property
Property Get WarnOnAttach() As Boolean
WarnOnAttach = ReadKey(mRegNameSecurity, mWarnOnAttach)
End Property
Property Let WarnOnAttach(newVal As Boolean)
WriteKey mRegNameSecurity, mWarnOnAttach, CBoolToVal(newVal)
End Property
Property Get WarnOnConnection() As Boolean
WarnOnConnection = ReadKey(mRegNameSecurity, mWarnOnConnection)
End Property
Property Let WarnOnConnection(newVal As Boolean)
WriteKey mRegNameSecurity, mWarnOnConnection, CBoolToVal(newVal)
End Property
Property Get SecurityLevel() As Byte
SecurityLevel = ReadKey(mRegNameSecurity, mSecurityLevel)
End Property
Property Let SecurityLevel(ByVal newVal As Byte)
WriteKey mRegNameSecurity, mSecurityLevel, newVal
End Property
Private Function CBoolToVal(bVal As Boolean) As Byte
If bVal Then
CBoolToVal = 1
Else
CBoolToVal = 0
End If
End Function
Property Get Language() As String
Language = ReadKey(mRegNameLang, mLang)
End Property
Property Let Language(nVal As String)
WriteKey mRegNameLang, mLang, nVal, REG_SZ
End Property
Private Function ReadKey(regKey As String, regValue As String) As Variant
Dim regName As String
On Error GoTo EH
regName = regKey & regValue
ReadKey = mRegKey.ReadKey(regName)
Exit Function
EH:
ReadKey = ""
End Function
Private Function WriteKey(keyPath As String, key As String, ByVal newValue As String, Optional ByVal inpType As regType = REG_DWORD) As Boolean
Dim regName As String
On Error GoTo EH
regName = keyPath & key
WriteKey = mRegKey.WriteKey(regName, newValue, inpType)
Exit Function
EH:
WriteKey = False
End Function
Function isGuiRunning()
Dim sapAppl As Object
On Error Resume Next
Set sapAppl = GetObject("SAPGUI")
On Error GoTo 0
If sapAppl Is Nothing Then
isGuiRunning = False
Else
isGuiRunning = True
End If
End Function
Private Sub Class_Initialize()
Set mRegKey = New Registry
End Sub
Это реестр классов (я переименовал класс)
Option Explicit
Private wsh As Object
Enum regType
REG_DWORD = 0
REG_SZ = 1
REG_EXPAND_SZ = 2
REG_BINARY = 3
End Enum
Function ReadKey(key As String) As Variant
On Error GoTo EH
ReadKey = wsh.RegRead(key)
Exit Function
EH:
ReadKey = vbNullChar
End Function
Function DeleteKey(key As String) As Boolean
On Error GoTo EH
wsh.RegDelete key
DeleteKey = True
Exit Function
EH:
DeleteKey = False
End Function
Function WriteKey(key As String, ByVal Value As Variant, Optional ByVal inpType As regType = REG_DWORD) As Boolean
' regType could be REG_SZ, REG_EXPAND_SZ, REG_DWORD, REG_BINARY
On Error GoTo EH
wsh.RegWrite key, Value, convRegType(inpType)
WriteKey = True
Exit Function
EH:
WriteKey = False
End Function
Private Function convRegType(inpType As regType) As String
Select Case inpType
Case REG_BINARY
convRegType = "REG_BINARY"
Case REG_DWORD
convRegType = "REG_DWORD"
Case REG_EXPAND_SZ
convRegType = "REG_EXPAND_SZ"
Case REG_SZ
convRegType = "REG_SZ"
Case Else
convRegType = ""
End Select
End Function
Private Sub Class_Initialize()
Set wsh = CreateObject("WScript.Shell")
End Sub
Ваш вопрос касается изменения параметра графического интерфейса SAP «Язык» (и, возможно, также «Использовать язык входа в систему SAP по умолчанию на экране входа в систему», который должен быть выбран), выполнив изменение через реестр Windows и вернувшись обратно.
Для информации (для других людей) эти варианты находятся здесь:
К вашему сведению, ваш сценарий также не может изменять реестр Windows и подключаться к языку «EN» на экране входа в графический интерфейс SAP, или вы можете подключиться с помощью сценария с нужным вам языком: