Error 61704 during calling RFC_READ_TABLE in VBA - vba

I am trying to connect to SAP via RFC objects:
Dim sap As Object
Set sap = CreateObject("SAP.Functions.unicode")
sap.connection.system = "xxxxxxxx"
sap.connection.Client = "700"
sap.connection.User = "USER"
sap.connection.Password = "PASS"
sap.connection.Language = "EN"
If sap.connection.Logon(1, False) <> True Then 'Try Logon
MsgBox "Cannot Log on to SAP"
End If
'*************************************************************
'Define the table specifics
'************************************************************
Dim objRfcFunc As Object
Set objRfcFunc = sap.Add("RFC_READ_TABLE") 'IN THIS LINE MY ERROR OCCURS
Internal application error - runtime error:61704
Any solutions?
It seems like my connection is OK. Could you check my connection variables?

The following code I took from here and adjusted it worked for me. Of course you have to change the connection parameters (username etc.) as well. I guess your issue is you do not have a connection in the first place.
Sub Test_RFC()
' Connect to SAP
Dim oSAP As Object
Set oSAP = CreateObject("SAP.Functions.unicode")
' Connection parameters - to be adjusted
oSAP.Connection.ApplicationServer = "1.1.1.1" ' IP des Appl-Servers (SM51->Details)
oSAP.Connection.SystemNumber = "01" ' Systemnummer, meißt im Namen des Appl-Servers enthalten
oSAP.Connection.System = "XD1" ' Entwicklungs-, Test-, Produktivsystem
oSAP.Connection.Client = "100" ' Mandant
oSAP.Connection.Language = "DE" ' Sprache "EN", "DE" ...
' RFC-Login: Show logon popup
If oSAP.Connection.Logon(0, False) = True Then
'You can only add a function module in case you have a connection
Dim oFuBa As Object
Set oFuBa = oSAP.Add("RFC_READ_TABLE")
End If
End Sub

Related

Excel VBA error while check logon and logout check using IE

I am amature VBA programmer. I am working in a small automation.
The steps are
Open a IE browser
Navigate to a webpage
Logon using my username and password
I am using below excel VBA code to get my solution
Code snippet
Sub LoginAuto()
Dim Myhtml As IHTMLElement
Dim Myurl As String
Myurl = "http://myurl.com"
Set Mybroswer = New InternetExplorer
Mybroswer.Silent = True
Mybroswer.navigate Myurl
Mybroswer.Visible = True
Do
Loop Until Mybroswer.readyState = READYSTATE_COMPLETE
Set HTMLDOC = Mybroswer.document
HTMLDOC.all.UserName.Value = "myuser"
HTMLDOC.all.Password.Value = "mypassword"
For Each Myhtml In HTMLDOC.getElementsByTagName("button")
If Myhtml.Type = "submit" Then
Myhtml.Click:
End If
Exit For
Next
End Sub
while running above program i am getting below error
excel vba automation error the object invoked has disconnected from its clients
Is Autoit (www-autoitscript.com) an option for you? It provides lots of useful functions to automate stuff like that.
Try this
#include<IE.au3>
$sUsername = "Username"
$sPassword = "Password"
$sUrl = "http://www.yoururl.com"
$oIE = _IECreate($sUrl, 0, 1, 1, 1)
$oHWND = _IEPropertyGet($oIE, "hwnd")
WinSetState($oHWND, "", #SW_MAXIMIZE)
$oForm = _IEFormGetCollection ($oIE, 0)
$oUsername = _IEFormElementGetObjByName($oForm, 'UserName')
$oPassword = _IEFormElementGetObjByName($oForm, "Password")
_IEFormElementSetValue($oUsername, $sUsername)
_IEFormElementSetValue($oPassword, $sPassword)
_IEFormSubmit ($oForm)
Dears,
I am able to resolve my reported problem by using "SHDocVw.InternetExplorer" instead of IHTMLElement
This allows me to "Loop Until Mybroswer.readyState = READYSTATE_COMPLETE"

.Net DirectorySearcher not retrieving all values in user object

As part of the program I'm writing, I have to retrieve all user data from the current user's AD object.
Here is the code I'm using...
Try
Dim RootEntry As New DirectoryEntry("LDAP://**USER OU**")
RootEntry.AuthenticationType = AuthenticationTypes.Secure
Dim ds As New DirectorySearcher(RootEntry)
ds.SizeLimit = System.Int32.MaxValue
ds.PageSize = System.Int32.MaxValue
ds.PropertiesToLoad.Add("cn") ' Common Name
' Personal
ds.PropertiesToLoad.Add("givenName") ' Given Name
ds.PropertiesToLoad.Add("sn") ' Surname
ds.PropertiesToLoad.Add("fullname") ' Full Name (GN + SN)
' Comms
ds.PropertiesToLoad.Add("telephoneNumber") ' Tel # (from general)
ds.PropertiesToLoad.Add("mail") ' Email (from general)
ds.PropertiesToLoad.Add("mobile") ' Mobile Phone (from Telephone)
' Job Role
ds.PropertiesToLoad.Add("title") ' Job Title (Organisation)
ds.PropertiesToLoad.Add("company") ' Company (Organisation)
ds.PropertiesToLoad.Add("department") ' Department (Organisation)
' Address
ds.PropertiesToLoad.Add("streetAddress")
ds.PropertiesToLoad.Add("l") ' City
ds.PropertiesToLoad.Add("st") ' State
ds.PropertiesToLoad.Add("postalCode") ' Post Code
ds.PropertiesToLoad.Add("co") ' Country
ds.ServerTimeLimit = New TimeSpan(0, 0, 60)
ds.SearchScope = SearchScope.Subtree
ds.Filter = "(&(anr=" & username(1) & ")(objectCategory=person))"
Dim searchresults As SearchResultCollection
searchresults = ds.FindAll()
Debug.Print("Search Results - " & searchresults.Count())
For Each result In searchresults
If Not result.Properties("givenName")(0) Is Nothing Then
strForename = result.Properties("givenName")(0)
Label1.Text = "Hello " & strForename & "!"
End If
If Not result.Properties("sn")(0) Is Nothing Then
strSurname = result.Properties("sn")(0)
End If
If Not strSurname Is Nothing And Not strForename Is Nothing Then
strName = result.Properties("givenName")(0) & " " & result.Properties("sn")(0)
End If
If Not result.Properties("title")(0) Is Nothing Then
strTitle = result.Properties("title")(0)
End If
If Not result.Properties("company")(0) Is Nothing Then
strCompany = result.Properties("company")(0)
End If
If Not result.Properties("department")(0) Is Nothing Then
strDepartment = result.Properties("department")(0)
End If
If Not result.Properties("telephoneNumber")(0) Is Nothing Then
strPhone = result.Properties("telephoneNumber")(0)
End If
If Not result.Properties("mobile")(0) Is Nothing Then
strMobile = result.Properties("mobile")(0)
End If
If Not result.Properties("mail")(0) Is Nothing Then
strEmail = result.Properties("mail")(0)
End If
If Not result.Properties("streetAddress")(0) Is Nothing Then
strStreet = result.Properties("streetAddress")(0)
End If
If Not result.Properties("l")(0) Is Nothing Then
strLocation = result.Properties("l")(0)
End If
If Not result.Properties("st")(0) Is Nothing Then
strCounty = result.Properties("st")(0)
End If
If Not result.Properties("postalCode")(0) Is Nothing Then
strPostCode = result.Properties("postalCode")(0)
End If
If Not result.Properties("co")(0) Is Nothing Then
strCountry = result.Properties("co")(0)
End If
strAddress = strStreet
Next
Catch ex As System.Exception
Debug.Print(ex.Message)
End Try
If I run the program, the system returns all my AD settings, populating each in the box.
If another user runs the program, the system returns only a partial result set, despite the items being completed on his ADUC properties dialog.
The Searcher is only returning 1 entry per user (given it sends the SAMAccountName) but I have set the PageSize and SizeLimit values to avoid the 1000 item issue.
I have also tried a simpler filter of samaccountname= & username(1), but to no avail.
Am I running into some undocumented/unreported AD security issue? My account used to be a Domain Admin, but isn't anymore following a security review.
The problem isn't related to computers, because if I run the program via impersonation on his computer, my details are returned in full and vice-versa (his aren't).
Ok, I traced the problem to the following...
If Not result.Properties("mobile")(0) Is Nothing Then
strMobile = result.Properties("mobile")(0)
Inc_Mob.Checked = True
Mob_TB.Text = strMobile
End If
Many users do not have mobile phone numbers and the DirectorySearcher will not create a null value if it tries to retrieve a value that is blank, it just fails to create it.
I wasn't handling it properly in the code and the Try loop wasn't explicitly stating what the problem was in the error message, instead just returning an ArgumentOutOfRangeException error.

System.__ComObject in LotusNotes in VB.net when extracting Attachments

I want to access a Lotus Notes Database and get attachments from documents in it.
I can open the DB and doc and loop through all items.
The problem is, I can not use the items as NotesRichTextItem and therefore not check if there are any item.EmbeddedObject.
I guess it is a problem with declaration of the items.
In general: If I debug using VS2010, doc and the database and NotesSession have the "value" System.__ComObject and "type" is the Domino.Notes Object it should be.
e.g. doc in WATCH:
Name VALUE TYPE
doc {System.__ComObject} Domino.NotesDocument
but if I use the doc.GetType() command the result is
doc.GetType() = {Name = "__ComObject" FullName = "System.__ComObject"}
Since I do not know if my doc.item is a NotesRichTextItem, I define it as an object and want to check afterwards is type. Which I can't since the return value of the functions is as above for doc, too.
Here is the complete code I use currently, I loaded the Lotus Domino reference from the COM section.
Public Sub OpenDocumentLN()
Try
Dim ns As New Domino.NotesSession
Dim db As Domino.NotesDatabase
Dim doc As Domino.NotesDocument
Dim view As Domino.NotesView
If Not (ns Is Nothing) Then
ns.Initialize()
db = ns.GetDatabase("", sLotusNotesPath & sLotusNotesDB, False)
If Not (db Is Nothing) Then
view = db.GetView(sLotusView)
doc = view.GetFirstDocument
While Not doc Is Nothing
Dim lnNextDoc As Domino.NotesDocument = view.GetNextDocument(doc)
For Each item As Domino.NotesItem In doc.Items
Dim rtItem As Object = doc.GetFirstItem(item.Name)
If rtItem Is Nothing Then Continue For
If Not rtItem.GetType() = GetType(Domino.NotesRichTextItem) Then Continue For
' NEVER reach this part of the code since the IF clause prevents it due to the type problem
If rtItem.EmbeddedObjects Is Nothing Then Continue For
For Each o As Domino.NotesEmbeddedObject In rtItem.EmbeddedObjects
o.ExtractFile(sLotusExportPath & o.Source)
Next
Next
doc = lnNextDoc
End While
End If
db = Nothing
ns = Nothing
End If
Catch ex As Exception
End Try
End Sub
How can I use my rtitem as a NotesRichTextItem so I can handle it appropiate? And why are all objects are treated als ComObjects?

No RFC authorization for function module RFC PING from VBA?

Good morning, everybody!
I've been looking for the solution in the last days but I really have not managed to succeed: I am trying to make a VBA code to:
log into SAP,
run some transactions,
export to excel.
But even the "log into SAP" part is not OK!
I tried several codes, the one below OPENS the SAP logon screen, but does not fill in any fields.
In the first attempt, I Used CreateObject("Sapgui.ScriptingCtrl.1"):
Sub Entrar_SAP()
If Not IsObject(SAPguiApp) Then
Set SAPguiApp = CreateObject("Sapgui.ScriptingCtrl.1")
End If
If Not IsObject(Connection) Then
Set Connection = SAPguiApp.OpenConnection("xxxxxxx)", True)
End If
If Not IsObject(session) Then
Set session = Connection.Children(0)
End If
session.findById("wnd[0]/usr/txtRSYST-MANDT").Text = "100"
session.findById("wnd[0]/usr/txtRSYST-BNAME").Text = "user"
session.findById("wnd[0]/usr/pwdRSYST-BCODE").Text = "pass"
session.findById("wnd[0]/usr/txtRSYST-LANGU").Text = "PT"
session.findById("wnd[0]/usr/txtRSYST-LANGU").SetFocus
session.findById("wnd[0]/usr/txtRSYST-LANGU").caretPosition = 2
session.findById("wnd[0]").sendVKey 0
In the second attempt, I tried CreateObject("SAP.Functions"), it showed:
"RFC error received. No RFC authorization for function module RFC PING"
The code is:
'Declaration
Dim objBAPIControl As Object 'Function Control (Collective object)
Dim sapConnection As Object 'Connection object
Set objBAPIControl = CreateObject("SAP.Functions")
Set sapConnection = objBAPIControl.Connection
sapConnection.Client = "xxxxx"
sapConnection.User = "xxxxxx"
sapConnection.Language = "PT"
sapConnection.hostname = "xxxxx"
sapConnection.Password = "xxxxxxxx" 'Fake password
sapConnection.SystemNumber = "4"
sapConnection.System = "xxxxxx)"
sapConnection.Logon
If sapConnection.Logon(1, True) <> True Then
MsgBox "No connection to R/3!"
Exit Sub 'End program
End If
Can someone please help me? Thanks!!
First of all, RFC is a perfectly fine method for interacting with SAP. It's not out of support.
Second, you don't have enough authorization so your code will not work even if you get the syntax right. "RFC error received. No RFC authorization for function module RFC PING". Ask your SAP team to give you access to execute RFCs remotely. Ask for SAP_S_RFCACL.
On a side note, your main object of running some transactions and exporting to Excel is quite easy to do in SAP. Maybe you should just ask your SAP team to do it for you instead of developing it in VBA?
I assume your pulling via an RFC read Table. This Connection will work fine for those.
Dim LogonControl As Object
Dim conn As Object
Dim retcd As Boolean
Set LogonControl = CreateObject("SAP.LogonControl.1")
Set conn = LogonControl.NewConnection
conn.System = "strSystemName"
conn.Client = "100"
conn.Language = "EN"
conn.User = "sUserName"
conn.Password = "strPassword"
retcd = conn.Logon(0, True) 'True = No logon GUI 'False = logon GUI
If retcd <> True Then
MsgBox "Login failed for- " & strSystemName & " -UserName or Password are incorrect, check them and run try again ."
Exit Sub
End If
Set funcControl = CreateObject("SAP.Functions")
funcControl.Connection = conn
From this Point on you can make your RFC call without any issues.
But to be truthful though, Above is almost exactly what you have as your second example. your RFC Error your getting seems like you don't have security settings for SAP to make RFC calls to whatever table your pulling from and not a problem with your login code.
Disclaimer: RFC_READ_TABLE is NOT supported by SAP and is more of a backdoor then a day to day method for pulling data.
Edit1: To Cover the Comments and not turn this into a discussion I will try and Summarize them here.
Firstly
the pop-up: If you want the pop-up for the log in then you need to change this line of code
retcd = conn.Logon(0, True)
to
retcd = conn.Logon(0, False) 'This one DISPLAYS the pop-up
Secondly
The Permissions: RFC_Read_Table uses Very Different Security Settings then a SAP t-Code uses, The technical Difference is difficult to explain but for a rule of thumb, If you cant access the SAP Table (t-Code SE16) you most likely not be able to pull it from RFC Read Table
Thirdly
If your company has Multiple SAP boxes (DEV, production, test) the Systemname would be EXACTLY what shows up on the box selection screen of SAP under name. assuming you were getting an RFC error from your second code block then the box name you used in that code would be the correct one.
You can bypass RFC controls and just go for a normal scripting that imitates a human user and manually introduces username and password. Credit to The Script Man from the SAP forums:
Sub SapLogin()
'Logs onto SAP system
Dim SapGuiApp As Object
Dim oConnection As Object
Dim session As Object
Dim SAPCon As Object, SAPSesi As Object
Dim SAPGUIAuto As Object, SAPApp As Object
Dim system As String
system = "XX" 'SAP system you will log on to like "01. ENGINEERING PRODUCTION [EG1]
If SapGuiApp Is Nothing Then
Set SapGuiApp = CreateObject("Sapgui.ScriptingCtrl.1")
End If
If oConnection Is Nothing Then
Set oConnection = SapGuiApp.OpenConnection(system, True)
End If
If SAPSesi Is Nothing Then
Set SAPSesi = oConnection.Children(0)
End If
Application.DisplayAlerts = FALSE
With SAPSesi
.FindById("wnd[0]/usr/txtRSYST-MANDT").Text = "100"
.FindById("wnd[0]/usr/txtRSYST-BNAME").Text = "USERNAME"
.FindById("wnd[0]/usr/pwdRSYST-BCODE").Text = "PASSWORD"
.FindById("wnd[0]/usr/txtRSYST-LANGU").Text = "EN"
.FindById("wnd[0]").SendVKey 0
'start extraction
.FindById("wnd[0]").Maximize
.FindById("wnd[0]/tbar[0]/okcd").Text = "/TCODEYOUWANTTORUN"
.FindById("wnd[0]").SendVKey 0
'...
'etc
'...
End With
Application.DisplayAlerts = True
MsgBox "After clicking OK, this SAP session is terminated."
End Sub

Connect to a specific lotus notes database/documen via vba

I can connect to lotus notes via the following code. So basically I connect to the database: CLASTNAME/O=TEST/C=US.nsf
Set oSession = CreateObject("Notes.NotesSession")
Server = oSession.GetEnvironmentString("MailServer", True)
UserName = oSession.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Open the mail database in notes
Set db = oSession.GETDATABASE("", MailDbName)
Set view = db.GetView("Customers") //ERROR
However, I want to connect to a specific database, which I have. Here is the document link:
<NDL>
<REPLICA C1451C8A:00575D55>
<VIEW OD3B89A25B:7D1FR7SA-OM4923732F:011L111C>
<NOTE OFAAAA64WE:GH1Q0W0W-IUZ0987MNB:2222F4LÖ>
<HINT>CN=ZZZUSDMS09/O=ZZZ/C=US</HINT>
<REM>Database 'UserName', View 'Customers', Document 'AG: A list of all company customers, Jannuary 9, 2009'</REM>
</NDL>
This is what I tried:
Sub notesBB()
'Const DATABASE = ""
Dim r As Integer
Dim i As Integer
Dim db As Object
Dim view As Object
Dim Entry As Object
Dim nav As Object
Dim oSession As Object 'The notes session
Dim nam As Object ' notes username
Dim v() As Variant ' to hold the subtotal values
Dim bills(12, 16) ' 12 months, 16 departments
r = 1
Worksheets(1).Range("A1:Z99").Clear
'##############################
'Start a session to notes
Set oSession = CreateObject("Notes.NotesSession")
Server = oSession.GetEnvironmentString("MailServer", True)
UserName = "CN=ZZZUSDMS09/O=ZZZ/C=US" 'oSession.UserName
CustomerDbName = "CZZZUSDMS09/O=ZZZ/C=US" & ".nsf"
'Open the mail database in notes
Set db = oSession.GETDATABASE("", CustomerDbName)
Set view = db.GetView("OD3B89A25B:7D1FR7SA-OM4923732F:011L111C")
view.AutoUpdate = True // here I get an error
Set nav = view.CreateViewNav
Set Entry = nav.GetFirst
Do Until Entry Is Nothing
If Entry.isCategory Then
r = r + 1
v = Entry.ColumnValues
For i = 1 To 16
bills(v(0), i) = v(4 + i)
Cells(4 + r, 2 + i) = bills(v(0), i)
Next
End If
Set Entry = nav.getNextCategory(Entry)
DoEvents
Loop
End Sub
However, as you can see I get an error hee: view.AutoUpdate = True // here I get an error
How to connect to this database via vba?
I really appreciate your answer!
Well, this doesn't look right:
CustomerDbName = "CZZZUSDMS09/O=ZZZ/C=US" & ".nsf"
'Open the mail database in notes
Set db = oSession.GETDATABASE("", CustomerDbName)
You're just appending ".nsf" to the user's fully disntinguished name in canonical form, and that would be an extremely unusual naming convention for databases on a server. Also, earlier in your code you retrieved the server name, but here you're specifying "" for the server name instead of using what you had retrieved, so the result is that the code will try to open the database on the local machine.
The NDL file is giving you the ReplicaID of the database here:
<REPLICA C1451C8A:00575D55>
You can use the OpenByReplicalID method instead:
repID = "C1451C8A00575D55" ' note that the : is removed
'Open the database by replica id
set db = new NotesDatabase("","")
If db.OpenByReplicaID( , "85255FA900747B84" ) Then
Print( db.Title & " was successfully opened" )
Else
Print( "Unable to open database" )
End If
The next problem, though, is that the NDL file is giving the view's UNID, not its name
<VIEW OD3B89A25B:7D1FR7SA-OM4923732F:011L111C>
There is no call in the Notes COM API that can retrieve a view by its UNID; you need the name for that. But do you really need to get the view? The NDL gives you the UNID of the document, here:
<NOTE OFAAAA64WE:GH1Q0W0W-IUZ0987MNB:2222F4LÖ>
So if your goal is to just get the specific document specified in the NDL, you can use a call to GetDocumentByUNID. Note, however that the actual UNID consists of only the 17 chars to the right of OF in the above tag, minus the : char. So your code would look like this:
unid = "AAAA64WEGH1Q0W0W" ' see note below!!
Set doc = db.GetDocumentByUnid(unid)
BTW, that UNID does not look legal. The chars should be hex, and the W, Q, and G are not. I'm going on the assumption that you (or someone) deliberately obfuscated the data in your NDL file.
If you do need to access the view, the NotesNoteCollection class may provide a way to get there, but it will not be trivial.
Finally, you may find this code from Stepehn Wissel helpful.
Specify the name of the view instead:
Set view = db.GetView("Customer")
Nice to see my code getting recycled ! it seems to me that you aren't using the correct database and view names. Are they not
Database 'UserName', and View 'Customers' ? (from your link). Whatever - when your XL VBA crashes out, in the Debug - Locals window, look for the object(s) that you have tried to instantiate with the SET command. If they show up as "nothing", you've got the SET command(s) wrong and trying to use the failed object (view) then crashes on the following line.
If your servername is "Yoda" I'd guess you need
Set db = session.getdatabase("Yoda", "Username.nsf")
Set view = db.GetView("Customers")