VBA Excel SSO to SAP / runtime error 70 "access denied" - vba

I spend hours finding the problem.
I want to start the SAP Logonpad with the ini file, that works fine.
Then after binding to the scripting object I want to open the connection to a specific System with connection = SapGui.OpenConnection("SID", True)
but always get runtime error 70 access denied.
I followed what others seem to do with vbs, for certain resons I can't do it with vbs and have to go with vba, so maybe there might be some difference that makes it fail?
Any advice would be highly appreciated.
Private Sub CommandButton1_Click()
Dim SapGui As Object
Dim saplogon As Object
Dim connection 'As Object
Set SapGui = GetObject("SAPGUI")
Dim Wshshell As Object
Set Wshshell = CreateObject("Wscript.Shell")
Wshshell.Run Chr(34) & ("C:\Program Files\SAPPC\FrontEnd\SAPgui
\saplogon.exe") & Chr(34) & " " & "/INI_FILE" & "=" & Chr(34) &
"\\longpathtoini\appl\Sap\saplogon\int\saplogon.ini" & Chr(34)
Do Until Wshshell.AppActivate("SAP Logon")
Application.Wait Now + TimeValue("0:00:01")
Loop
Set Wshell = Nothing
Set saplogon = SapGui.GetScriptingEngine
connection = SapGui.OpenConnection("SID", True)
Set SapGui = Nothing
Set saplogon = Nothing
Set connection = Nothing
End Sub

Check whether user scripting is allowed for the particular system (transaction RZ11, parameter sapgui/user_scripting). Also be aware that for some versions, you'll apparently need to specify the SAP Logon entry text instead of the SID.

Thanks to vwegert.
I surely knew about scripting needs to be enabled on the servers.
Which is, but at the moment I read his answer I remembered that in my SAP GUI settings the checkbox for "Warn if a script tries to connect" was enabled.
Disabeling that options did lead to success.
The above code works perfectly.

Related

I'm trying to implement late binding on an access front end and can not get a DAO refrence to work

I'm working on making a database late bound, so that when the front end is opened, users with different version of MS Office won't have issues. I keep on getting a run time error 438 (Object doesn't support this properts or method) in this code, on the line with For Each tdf In dbs.TableDefs.
I can't see what is going wrong here. Everything is declared and it should find it. Can someone point out what might be happening?
Function RelinkTables()
On Error GoTo EndFast
'Routine to relink the tables automatically. Change the constant LnkDataBase to the desired one and run the sub
'DB front end could be used in 2 or more locations with different backends.
Dim dbs As Object
#If VBA7 Then
Set dbs = CreateObject("DAO.DBEngine.120")
#Else
Set dbs = CreateObject("DAO.DBEngine.36")
#End If
' Dim dbs As DAO.Database
' Set dbs = CurrentDb
Dim tdf As Object
'Dim tdf As DAO.TableDef
Dim strTable As String
Dim strLocation As String
'Abandon relinking if file is development version
If VBA.InStr(1, VBA.UCase(GetNamePath), "_DEV") > 0 Then Exit Function
'Get the Path of the Document and form backend name
strLocation = GetFolderFromPath(GetNamePath)
strLocation = FormBackendName(strLocation)
'Go about relinking
For Each tdf In dbs.TableDefs
If VBA.Len(tdf.Connect) > 1 Then 'Only relink linked tables
'If tdf.Connect <> ";DATABASE=" & LnkDataBaseDubai Then 'only relink tables if the are not linked right '' With PW, Access wont relink, even when the PW is Correct. MUST RELINK!
If VBA.Left(tdf.Connect, 4) <> "ODBC" Then 'Don't want to relink any ODBC tables
strTable = tdf.Name
'dbs.TableDefs(strTable).Connect = ";DATABASE=" & strLocation & ";PWD=" & DatenbankPW 'With password
dbs.TableDefs(strTable).Connect = ";DATABASE=" & strLocation & ";" 'Without password
dbs.TableDefs(strTable).RefreshLink
End If
'End If
End If
Next tdf
dbs.Close
Exit Function
EndFast:
On Error GoTo 0
MsgBox "The backend database was not found. Without the backend this database does not work." & vbCrLf _
& "" & vbCrLf _
& "Ensure that an Access Backend DB is located in the a subfolder called: ""_Sources"" and that read and write permission for the folder are granted." & vbCrLf _
& "" & vbCrLf _
& "Contact the developer if further support is needed.", vbOKOnly Or vbExclamation Or vbSystemModal Or vbMsgBoxSetForeground, "Database backend not found"
End Function
You need to actually open a database if you want to use tables.
You have set dbs to be a database engine, not a database.
If you want it to be the current database, just set it as such, no early binding needed:
Dim dbs As Object
Set dbs = CurrentDb
Else, open up a database:
Dim dbs As Object
Dim dbe As Object
#If VBA7 Then
Set dbe = CreateObject("DAO.DBEngine.120")
#Else
Set dbe = CreateObject("DAO.DBEngine.36")
#End If
Set dbs = dbe.OpenDatabase("C:\Some database.mdb")
' Must be mdb since DAO.DBEngine.36 doesn't support accdb
Access does not require a reference to the DAO library anymore (since Access 2007, the DAO library is built in). so REMOVE the dao reference. You don't need it, and late binding will NOT help nor change the broken reference issue.
So, you will note the references are now this:
You cannot remove the ACE data engine reference, but you REALLY want to make sure you do NOT reference the DAO object library.
You ONLY reference DAO if you using a pre-2007 database, and ALSO that you NOT use ACE, and using a mdb file.
For accDB, and access 2007 onwards?
The Access team now owns DAO for Access and they do NOT update nor maintain the external DAO library now. DO NOT reference DAO library.
So, DAO is now built into Access. (but yes, you do have to referance the ACE data engine now)
However, EVEN with the above references, you can, and should make a habit of referencing DAO in your code, since it not only a good habit, but also gives you intel-sense as a bonus.
Good idea to have a option explict in your code modules.
So, no need to late bind DAO, since you don't need the reference to DAO anymore!!

Problems With Outlook Automatically Closing From Access Database

I was just upgraded to windows 10. This version of outlook I have enabled the macros in the trust center however it limits me on running vba from outlook. Also access is having issues when I run the task scheduler and run from a bat file the access database. An autoexec excutes and I tell the system to shut outlook down but it won't shut down the current instance of the outlook. Here Is the code I am using.
Public Function OutlookClose1()
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess In colProcessList
Set objOutlook = GetObject(Class:="Outlook.application")
objOutlook.Quit
Next
End Function
Public Function OutlookClose2()
Dim objAppOL As Outlook.Application
On Error Resume Next
Set objAppOL = GetObject(Class:="Outlook.application")
objAppOL.Quit
Set objAppOL = Nothing
Exit Function
End Function
I have tried outlookclose1 and 2 and neither work. DOes anyone have suggestions?
Also when running the outlookclose1 from the vba editor it does close. It takes the exchange offline, which I don't want. But from a bat file running the access database and having the autoexec run it it doesn't close down outlook.
Task scheduler runs as a service in a security context different from the currently logged in user even if the local user account is the same. COM system refuses to marshal calls between processes running in different security contexts.
I have office 2013 and windows 10. I could use the above code with Windows 7 and the task scheduler. I am on a domain with certain policies that I can't change and I don't have admin rights. At home not on a domain I can use that code too. With that being said I can at least terminate outlook from access and get the job done closing an outlook session so when the autoexec runs in the access database it closes outlook and then runs the reports and sends, Create Object Outlook.Application and it sends emails no problems. Here is how I terminate the code. The reason is I don't want multiple outlook sessions running.
Public Function OutlookClose1()
Dim objOutlook As Outlook.Application
delay = 30000 'delay in milliseconds to let Outlook close gracefully
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess In colProcessList
objProcess.Terminate
Next
Set objWMIService = Nothing
Set objOutlook = Nothing
Set colProcessList = Nothing
End Function

Changing the Folder security permissions using Excel VBA

I am trying to write some code to put a text file into a secure folder. The folder has attributes already set to read-only so that the files within are secure and cannot be altered but still read.
The FileSystemObject will allow me to use the attribute property which I can set to 1 (read-only) but this is easily overridden.
My next port of call was to GetAclInformation etc.
I downloaded some code and I got through a large portion of it but, at GetAclInformation it crashes Excel.
I then continued to look and so used the ADsSecurity dll. This returns an error stating
the ActiveX cannot create the object.
I have downloaded a copy of the dll and put it into the windows\syswow64 directory and then registered it with RegSvr32 which returned a success.
I can add the references required and see the object in the object viewer. But trying both late and early binding has no affect and it still errors saying the ActiveX cannot create the object.
Does anyone have any other ideas or a suggestion on what to try?
Sub TestApproval()
Dim oSec As New ADsSecurity
Dim oSd As Object, oDac1 As Object, oAce As Object
Set oSec = New ADsSecurity
Set oSd = oSec.GetSecurityDescriptor(CStr("FILE://C:\Test"))
Set oDac1 = oSd.DiscretionaryAcl
For Each oAce In oDac1
Debug.Print oAce.trustee & "|" & oAce.AceType & "|" & oAce.AccessMask & "|" & oAce.AceFlags & "|" & oAce.Flags & "|" & oAce.ObjectType & "|" & oAce.InheritedObjectType
Next oAce
Set oSec = Nothing
Set oSd = Nothing
Set oDac1 = Nothing
End Sub
Thanks in advance :)

Ping server process is hanging

I am trying to ping a server before uploading a file with ftp. Recently, a client complained that the process was freezing. I tested the ping process with a vbscript file just to make sure something wasn't broken on the computer. The vbscript worked just fine. So I ran the script from the Access database and it hung just the same as it did before. Is there something about the ping exe that I am missing here?
Vbscript that runs just fine when you double click it.
Const fsoForWriting = 2
Dim oShell, ping, strPath, strPing
Set oShell = WScript.CreateObject ("WScript.Shell")
Set ping = oShell.exec("ping -n 2 -w 750 google.com")
Do While ping.Status = 0
WScript.Sleep 100
Loop
strPing = ping.StdOut.ReadAll
strPath = Wscript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
strTextFile = objFSO.GetParentFolderName(strPath) & "\PingResults.txt"
Set objTextStream = objFSO.OpenTextFile(strTextFile, fsoForWriting, True)
objTextStream.WriteLine strPing
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
Set oShell = Nothing
VBA function that runs on the test database on startup. This is the code that hangs.
Function fFtpOnline(ByVal ComputerName As String)
On Error GoTo ErrHandler
Dim oShell, ping
Set oShell = CreateObject("WScript.Shell")
Set ping = oShell.exec("cscript " & Access.CurrentProject.Path & "\" & "Test.vbs")
Do While ping.Status = 0
DoEvents
Loop
Set oShell = Nothing
Exit Function
ErrHandler:
MsgBox Err.Description & " " & "fFtpOnline "
Resume Next
End Function
This code works fine on my computer but on the client's computer, the code hangs.
This may sound like a rude answer, but by no means is it intended to be. Just as the comment above stated, this is more than likely it issue on your customer's end. If the program works currently on your end and not theirs they have the issue, not the code. I've run into plenty of customers who are clueless so unless they are willing to let you take control of their machine remotely I would recommend them capturing some information for you. ipconfig is a good place to start. And while they are at the command prompt have them try to ping some places. I know this is not a true answer, but it is what I have encountered in the past.

Create a shortcut to current folder on user's desktop

I would like to automatically create a shortcut to the current's folder on the user's desktop. Some users I'm working with don't know how to create shortcuts or how to drag and drop a folder. I just want to create a file named "CLICK ME TO CREATE A SHORTCUT TO THIS FOLDER ON YOUR DESKTOP" that will work in any folder I want.
For example, if I run C:\myRandomFolder\CLICK ME.whatever, I want it to create a shortcut to "C:\myRandomFolder\" named "myRandomFolder" on "D:\Documents and Settings\%username%\Desktop".
I'm wondering if I'm better using a batch file (.bat), VB Script (.vbs) or any other scripting language to do so. What would be the easiest and better way of doing it?
The best way finally seems to be a VBS Script. Here is what I finally got working right:
Option Explicit
On Error Resume Next
Private WshShell
Private strDesktop
Private oShellLink
Private aSplit
set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
aSplit = Split(WScript.ScriptFullName, "\")
set oShellLink = WshShell.CreateShortcut(strDesktop & "\" & aSplit(Ubound(aSplit) - 1) & ".lnk")
oShellLink.TargetPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
oShellLink.WindowStyle = 1
oShellLink.Description = "Shortcut Script"
oShellLink.WorkingDirectory = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
oShellLink.Save
MsgBox "Shortcut to " & Replace(WScript.ScriptFullName, WScript.ScriptName, "") & " added yo your desktop!"
Great code! Out of curiosity, since this works for the directory the script is currently in, do you have a way to get it to show up in every directory? Otherwise, it doesn't seem like there's much difference between learning this and learning to make a shortcut the native way. You would still have to drag and drop the script into the current folder, wouldn't you?
While stumbling toward a solution, I got as far as letting users navigate to and select a particular file they need to link to. I don't know if you would have any use for that.
Dim diaSelectFile
Set diaSelectFile = Application.FileDialog(msoFileDialogFilePicker)
diaSelectFile.Show
strPickedFile = diaSelectFile.SelectedItems(1)
Set diaSelectFile = Nothing
Dim oWsh
Dim myshortcut
Dim oShortcut
Dim strSplitFileName
Dim strTarget
Dim nShortName
Set oWsh = CreateObject("WScript.Shell")
strSplitFileName = Split(strPickedFile, "\")
nShortName = UBound(strSplitFileName)
strTarget = strSplitFileName(nShortName)
myshortcut = "C:\users\%USERNAME%\Desktop\" & strTarget & " - Shortcut" & ".lnk"
Set oShortcut = oWsh.CreateShortcut(myshortcut)
With oShortcut
.TargetPath = strPickedFile
.Save
End With
Set oWsh = Nothing
Set oShortcut = Nothing
Again, though, this feels more complex than right-clicking and sending a shortcut to the desktop. Who are the users that need this? I know I've had austistic friends who struggle with what we might consider basic tasks on the computer. I'd definitely be interested to know if the script you came up with actually helps your clientele.