Get SAP System Date - vba

Using SAP scripting, I'm trying to figure out a way of obtaining SAP's current system date.
If I following System > Status..., there is a field displaying the SAP system's current time, but unfortunately there is no field for the current date. Code below.
Set SapGuiAuto = GetObject("SAPGUI")
Set SAPApp = SapGuiAuto.GetScriptingEngine
Set SAPConnection = SAPApp.Children(0)
Set session = SAPConnection.Children(0)
Dim systemDate, systemTime As String
session.findById("wnd[0]/mbar/menu[4]/menu[11]").Select
systemTime = session.findById("wnd[1]/usr/ctxtSYST-UZEIT").Text
'systemDate = .....
I feel like there must be a simple way of getting the system date, but after hours of searching the web I have come up with nothing. Any help would be appreciated, thanks.
EDIT:
I have found one solution, sort of. It's not the simplest way, but I can save a variant in one of SAP's transaction (IW37N) so that it auto populates a date and a time field with a dynamic value of now upon entry. Once the variant is saved, I can use SAP scripting to access the transaction > access the variant > access the two dynamic fields (code below). Again, not really the simplest option, so I'm open to hearing better ideas.
'Connect to SAP
Set SapGuiAuto = GetObject("SAPGUI")
Set SAPApp = SapGuiAuto.GetScriptingEngine
Set SAPConnection = SAPApp.Children(0)
Set session = SAPConnection.Children(0)
'Enter Transaction
session.findById("wnd[0]/tbar[0]/okcd").Text = "/NIW37N"
session.findById("wnd[0]").sendVKey 0
'Select Variant
session.findById("wnd[0]/tbar[1]/btn[17]").press
session.findById("wnd[1]/usr/txtV-LOW").Text = "TEST001"
session.findById("wnd[1]/usr/ctxtENVIR-LOW").Text = ""
session.findById("wnd[1]/usr/txtENAME-LOW").Text = ""
session.findById("wnd[1]/usr/txtAENAME-LOW").Text = ""
session.findById("wnd[1]/usr/txtMLANGU-LOW").Text = ""
session.findById("wnd[1]/tbar[0]/btn[8]").press
'Select Dates Tab
session.findById("wnd[0]/usr/tabsTABSTRIP_TABBLOCK1/tabpS_TAB5").Select
'Get Field Values
Dim systemDate, systemTime As String
systemDate = session.findById("wnd[0]/usr/tabsTABSTRIP_TABBLOCK1/tabpS_TAB5/ssub%_SUBSCREEN_TABBLOCK1:RI_ORDER_OPERATION_LIST:1500/ctxtS_ISDD-LOW").Text
systemTime = session.findById("wnd[0]/usr/tabsTABSTRIP_TABBLOCK1/tabpS_TAB5/ssub%_SUBSCREEN_TABBLOCK1:RI_ORDER_OPERATION_LIST:1500/ctxtS_ISDZ-LOW").Text

Sergii was right. The problem is that the same dates are hidden. Thus, the variables are not available. I wanted to know, so I signed in to SAP shortly before midnight. It will look like that:
The script could look like this:
'...
session.findById("wnd[0]/mbar/menu[1]/menu[11]").select
on error resume next
LAST_LOGON_DATE = session.findById("wnd[1]/usr/ctxtLAST_LOGON_DATE").text
SESSION_START_DATE = session.findById("wnd[1]/usr/ctxtSESSION_START_DATE").text
SYST_DATE = session.findById("wnd[1]/usr/ctxtSYST-DATUM").setFocus
on error goto 0
session.findById("wnd[1]").close
if SESSION_START_DATE = "" then SESSION_START_DATE = LAST_LOGON_DATE
if SYST_DATE = "" then SYST_DATE = SESSION_START_DATE
msgbox LAST_LOGON_DATE & " / " & SESSION_START_DATE & " / " & SYST_DATE
'...
Regards,
ScriptMan

Let you try this:
systemDate = session.findById("wnd[1]/usr/ctxtSYST-DATUM").Text
You can see for details there:
https://archive.sap.com/discussions/thread/1095191
Regards
Sergii

Related

Why am I seeing Runtime error 3421 - access vba?

I have been using a vba code to make my work life easier but for some reason it stopped working as supposed to. What it does it gets a number from my DB and goes to website to find relevant certificate assigned to this number (company), then it reads the grade and expiry date which are to be recorded in same DB. The issue is now when it goes to
rs.fields("Expiry").Value = Split(sResult, "|")(1)
it throws a Runtime error 3421 which i believe is due to column being formatted as for date data type but it worked correctly for several months..? It work when changed data type to text however that will mess it up as later I use it in queries and reports and need it as a date.
Any ideas why it changed and how to fix it please?
Thanks
MD
Sub Get_BRCDirectory_Data()
Dim sCode, rs As DAO.Recordset, dic As Object, sResult As String, i As Long
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = 1
Set rs = CurrentDb.OpenRecordset("Approved")
If Not (rs.BOF And rs.EOF) Then
rs.MoveFirst
Do
sCode = rs.fields("SupplierCode").Value
If sCode <> "" Then
If Not dic.Exists(sCode) Then
sResult = GetGradeExpiryDate(CStr(sCode))
rs.Edit
rs.fields("Grade").Value = Trim(Split(sResult, "|")(0))
rs.fields("Expiry").Value = Split(sResult, "|")(1)
rs.UPDATE
dic(sCode) = Array(rs.fields("Grade").Value, rs.fields("Expiry").Value)
Else
rs.Edit
rs.fields("Grade").Value = dic(sCode)(0)
rs.fields("Expiry").Value = dic(sCode)(1)
rs.UPDATE
End If
End If
rs.MoveNext
Loop Until rs.EOF
End If
MsgBox "Done", 64

VBA SAP createsession

Maybe someone can help me with creating new SAP session using VBA Excel
Some code to understand the problem
If Not IsObject(sap) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set sap = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(Connection) Then
Set Connection = sap.Connections.Item(0)
End If
If Not IsObject(session) Then
Set session = Connection.Children(0)
End If
Most cases this one work fine. But sometimes this part doesn't work
Set session = Connection.Children(0)
it happens for example when SAP timeout occur (auto logoff after some idle time).
In that case I have
sap.Connections.Count
= 2
but
Connection.Sessions.Count
= 0
Looks like the timeouted connection still hangs somewhere in SAP. So when I try to connect to first session of first connection I got an error couse there is no session in first connection.
What I want to do is to create new session.
I can do this by
Dim sapSession As SAPFEWSELib.GuiSession
Dim sapCon As SAPFEWSELib.GuiConnection
Set sapCon = sap.Connections.Item(0)
Set sapSession = Connection.sessions.Item(0)
sapsession.createsession
This one works ok but it doesn't help couse I still need to set the session first
Is there a way to create session after setting the connection?
Something like sapCon.createsession
And does anyone know how can I use specific session using variable?
Set sapSession = Connection.sessions.Item(0)
This works ok but when I try
Dim SessionNumber as integer
....
SessionNumber = 0
Set sapSession = Connection.sessions.Item(SessionNumber)
it throws an error "Bad index type for collection access"
Excel requires that the session number is an integer, so you can use the type conversion from Cint(). Strange that this is advised/required even when SessionNumber is defined as an integer.
Dim SessionNumber
....
SessionNumber = 0
Set sapSession = Connection.sessions.Item(Cint(SessionNumber))
The CreateSession command executes quickly and returns to Excel, but SAP takes a while to finish opening the new session. Thus, you'll need to make your Excel code wait.
Here's an example:
Const ms as Double = 1.15740741E-08 ' one millisecond, in days = 1/(1000*24*60*60)
Dim sapCon As SAPFEWSELib.GuiConnection
Dim sapSession As SAPFEWSELib.GuiSession
Dim nSessions As Integer
Set sapCon = sap.Connections(0)
Set sapSession = sapCon.Sessions(0)
nSessions = sapCon.Sessions.Count
sapSession.createsession
Do
Application.Wait (Now() + 500*ms)
If sapCon.Sessions.Count > nSessions Then Exit Do
Loop
Set sapSession = sapCon.Sessions.Item(CInt(sapCon.Sessions.Count - 1))

How to properly from VBA connection from Excel sheet to another Excel sheet?

I currently have 2 separate Excel worksheets. One is data entry and another is display.
The display uses VBA to connect to data entry to obtain data. Normally, it functions well enough. However I'm required to have the 2 worksheets in separate windows, meaning both can be displayed at the same time in separate windows, in the same screen.
The issue in this scenario is that when I click Execute in display to begin SQL query, the display window opens another data entry worksheet (read-only) and reads that instead of the one I opened initially. Is this issue due to my connection string or my ADODB.Recordset has issues?
Here is the sub which contains the connection string and ADODB.Recordset.
Edit: Full code is included to provide full context for those who need it.
Public Sub QueryWorksheet(szSQL As String, rgStart As Range, wbWorkBook As String, AB As String)
Dim rsData As ADODB.Recordset
Dim szConnect As String
On Error GoTo ErrHandler
If AB = "1st" Then
wbWorkBook = ThisWorkbook.Sheets("Inner Workings").Range("B9").Text
End If
Application.StatusBar = "Retrieving data ....."
'Set up the connection string to excel - thisworkbook
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & wbWorkBook & ";" & _
"Extended Properties=Excel 8.0;"
Set rsData = New ADODB.Recordset
'Run the query as adCmdText
rsData.Open szSQL, szConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
'Check if data is returned
If Not rsData.EOF Then
'if the recordset contains data put them on the worksheet
rgStart.CopyFromRecordset rsData
Else
End If
'Close connection
rsData.Close
'Clean up and get out
Set rsData = Nothing
Application.StatusBar = False
Exit Sub
ErrHandler:
'an error occured in the SQL-statement
MsgBox "Your query could not be executed, the SQL-statement is incorrect."
Set rsData = Nothing
Application.StatusBar = False
End Sub
Sub process()
Call clear
Call testsql("1st") ' populate 1st Summary
Call testsql("2nd") ' find Date+Time
Call testsql("3rd") ' arrange record by newest
Call testsql("4th") ' show final results
End Sub
Sub testsql(AB As String)
Dim rgPlaceOutput As Range 'first cell for the output of the query
Dim stSQLstring As String 'text of the cell containing the SQL statement
Dim rg As String, SQL As String
If AB = "1st" Then
stSQLstring = ThisWorkbook.Sheets("Inner Workings").Range("B2").Text
Set rgPlaceOutput = ThisWorkbook.Sheets("1st Summary").Range("A2")
End If
If AB = "2nd" Then
stSQLstring = ThisWorkbook.Sheets("Inner Workings").Range("B3").Text
Set rgPlaceOutput = ThisWorkbook.Sheets("2nd Summary").Range("A2")
End If
If AB = "3rd" Then
stSQLstring = ThisWorkbook.Sheets("Inner Workings").Range("B4").Text
Set rgPlaceOutput = ThisWorkbook.Sheets("3rd Summary").Range("A2")
End If
If AB = "4th" Then
stSQLstring = ThisWorkbook.Sheets("Inner Workings").Range("B5").Text
Set rgPlaceOutput = ThisWorkbook.Sheets("Final Summary").Range("A5")
End If
QueryWorksheet stSQLstring, rgPlaceOutput, ThisWorkbook.FullName, AB
End Sub
Sub clear()
ActiveWorkbook.Sheets("1st Summary").Range("A2:BR5000").Value = Empty
ActiveWorkbook.Sheets("2nd Summary").Range("A2:BR5000").Value = Empty
ActiveWorkbook.Sheets("3rd Summary").Range("A2:BR5000").Value = Empty
ActiveWorkbook.Sheets("Final Summary").Range("A5:BR5000").Value = Empty
End Sub
Also another thing I noticed. Depending on which file I open first, it can result in both files creating a read-only copy when I click Execute. If I open Display first then Entry form, both in different instances of Excel, it will create read-only copies of both files.
If I open Entry form first, then Display in again, different instances of Excel, only the read-only copy of Display will appear.
The only time a read-only does not appear is when both files are in a single instance of Excel, which is not what I want.
Edit2:
For more info, here is the SQL I used (4 total)
SQL1 - select * from EntryTable
SQL2 - select A.*,[Date + Time] from Summary1 A left join (select [Die No], max (Date + Time) as [Date + Time] from Summary1 group by [Die No]) B on A.[Die No] = B.[Die No]
SQL3 - select * from Summary2 where [Date + Time] = Date + Time
SQL4 - select Project_No, Die_No, Description, Repair_Details, Status from Summary3
Workbook name in cell B9 = V:\Die Maintenance System v2\Die Maintenance Menu.xlsx
Update: My colleague has tested the system on her PC and tested no problems. I've been told its most likely my Excel settings. But for the life of me, I can't figure out what is causing it. What type of setting is used to prevent the read-only file from appearing?
Edit: I can see that this post has gone on too long. I decided to continue this on a new thread right here.
So i would do it with the Workbook.Open() Method.
Sub Example()
Dim wb as Workbook
Dim path as String
path = "C:\Users\User\Desktop\1.xlsx"
set wb = Workbook.Open(path)
End Sub
Now you can use wb to execute every vba function. Then there a options to check if a workbook is already opened, look here. I dont think you can do that with adodb.
I tired using ACE and it worked just fine. It didn't open a new file.
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & _
wbWorkBook & "';" & _
"Extended Properties='Excel 12.0;HDR=Yes;IMEX=1';"
Your SQL FROM clause is referencing a different named range. Please post your SQL text. It must be qualified to correct Named Range or sheet name.
SELECT Project No, Die No, Description, Repair Details, Status
FROM DATA1 <- correct this to qualified named range or sheet name
like
FROM [Entry Form$] 'or
FROM [Named Range] <- this can be found in Formulas | Name Manager
Edit:
I am not sure about your "1st" source workbook's location so let us try to insert the line I commented below
wbWorkBook = ThisWorkbook.Sheets("Inner Workings").Range("B9").Text
wbWorkBook = Workbooks(wbWorkbook).FullName '<- add this line
If it still does not work, please post your SQL AND Workbook name in cell B9.
Edit 2:
What is the result if you change the FROM clause like:
select * from [EntryTable$]
Edit 3: Do you have password? if so, try to disable it first to isolate the problem in read only.

Excel VBA Run Time Error '424' object required

I am totally new in VBA and coding in general,
i want to attache a pdf (Print.pdf) to a specific field (alias_3) in a lotus notes database but i am getting the error 424.
Any suggestions what i am doing incorrectly?
Sub aa()
Dim alias_3 As String
Set notesface = CreateObject("Notes.NotesSession")
Set makeup = Nothing
Set makeup = notesface.GetDatabase("C2S2/ConsolidatedContracts", "p_dir\bpcmrtuat.nsf")
Set docu = makeup.GetDocumentByID("00002BE6")
Attachment1 = "C:\Users\Desktop\aloxa\Print.pdf"
rtitem = docu.HasEmbedded
For Each test2 In docu.GetItemValue("alias_3")
test = test2.HasEmbedded ----> here i am getting the error
Set EmbedObj1 = docu.alias_3.embedobject(1454, "attachment1", Attachment1, "")
Exit For
Next test2
Set EmbedObj1 = test.embedobject(1454, "", Attachment1, "")
Set AttachME = test.CreateRichTextItem("attachment1")
docu.GetItemValue ("alias_3")
If Attachment1 <> "" Then
Set AttachME = docu.CreateRichTextItem("Attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", Attachment, "")
On Error GoTo 0
End If
ExitSub:
End Sub
According to the Lotus Note documentation, GetItemValue() returns either a String, an array of String, or an array of Doubles, none of them having a HasEmbedded property.
Your codes mixes getting values from an item with attaching things to another item, etc.
First of all: Do you REALLY have a richtextitem called "alias_3" in the design of the form that your document is made of? Or is the name of the item "Attachment1" as in your second part of the code? Or is it a default mail database, then the name of the item would be "Body"?
Just replace "alias_3" in the following code with the appropriate itemname. The complete code can be reduced to these lines (I replaced the variable names, so that another developer KNOWS what you mean by using "defaults"):
Set ses = CreateObject("Notes.NotesSession")
Set db = ses.GetDatabase("C2S2/ConsolidatedContracts", "p_dir\bpcmrtuat.nsf")
Set doc = db.GetDocumentByID("00002BE6") '- This line is dangerous, because the noteid can change easily...
strAttachmentPath = "C:\Users\Desktop\aloxa\Print.pdf"
Set rtItem = doc.GetFirstItem( "alias_3" )
If not rtItem.HasEmbedded() then
Call rtItem.embedobject(1454, "", strAttachmentPath , "")
Else
'- what do you want to do, if there is already an embedded attachment?
End if
Call doc.Save( True, True, True )

Update MS Access Marquee text on each loop

I admit to being a bit of a novice, but have designed myself a very handy personal MS Access database. I have tried to find a solution to the following on the net, but have been unsuccessful so far, hence my post (the first time I've done this).
I have a marquee on a form in MS Access, which scrolls the count of "incomplete tasks" to do. A "Tasks COUNT Query" provides a number from zero upwards. After the form loads, the code below scrolls a message (right to left) on the marquee in the form "There are X tasks requiring action." X is the number provided from the "Tasks COUNT Query". I would like the text string on the marquee to update on each loop, so that when I mark a task as complete, the next pass on the marquee shows the number (X) as being the updated count.
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim Number As String
Set db = CurrentDb
Set rst = db.OpenRecordset("Tasks COUNT Query")
If Not (rst.EOF And rst.BOF) Then
Do While Not rst.EOF
Number = rst![Tasks]
strTxt = strTxt & "There are " & Number & " tasks requiring action."
rst.MoveNext
Loop
End If
rst.Close
strTxt = Left(strTxt, Len(strTxt)) 'remove the coma at the end
strTxt = Space(30) & strTxt 'start position
Set rst = Nothing
Set db = Nothing
Me.TimerInterval = 180
End Sub
The following code runs on the form timer interval:
Private Sub Form_Timer()
Dim x
On Error GoTo Form_Timer_Err
x = Left(strTxt, 1)
strTxt = Right(strTxt, Len(strTxt) - 1)
strTxt = strTxt & x
lblMarqTask.Caption = Left(strTxt, 180)
Exit Sub
Form_Timer_Exit:
Exit Sub
Form_Timer_Err:
Me.TimerInterval = 0
Exit Sub
End Sub
I would be grateful for any assistance :)
To answer you question: -
I would like the text string on the marquee to update on each loop
To do this you need to place your code that collects the string into its own procedure and then pick a time to call it. I.e.
Move the Form_Load() code into its own procedure
Private Sub GetString()
Dim db As DAO.Database
... [The remaining code] ...
Me.TimerInterval = 180
End Sub
Change Form_Load() to call the new procedure
Private Sub Form_Load()
GetString
End Sub
Have the timer call the new procedure every so often to update the marquee (also known as ticker tape).
Private Sub Form_Timer()
Dim x
Static LngTimes As Long
On Error GoTo Form_Timer_Err
LngTimes = LngTimes + 1
If LngTimes = 100 Then
GetString
LngTimes = 0
End If
x = Left(StrTxt, 1)
StrTxt = Right(StrTxt, Len(StrTxt) - 1)
StrTxt = StrTxt & x
lblMarqTask.Caption = Left(StrTxt, 180)
Exit Sub
Form_Timer_Exit:
Exit Sub
This will update it every 100 times the timer runs. I have tested this and it works, albeit causing a judder in marquee scrolling.
I would like to take the time to give you some extra support in your code that may help understand VBA and make things clearer/easier for you in any future development.
The changes I have supplied are minimal to give you the desired result within the code you have currently. However it does mean I carried some issue across with it. I would perform the same feature with the below: -
Option Compare Database
Option Explicit
Private StrStatus As String
Private Sub GetStatus()
Dim Rs As DAO.Recordset
Set Rs = CurrentDb.OpenRecordset("SELECT count([Task]) FROM [TblTasks] WHERE [Done] = 'No'")
StrStatus = "There are " & Rs(0) & " tasks requiring action."
Rs.Close
Set Rs = Nothing
End Sub
Private Sub Form_Load()
Me.TimerInterval = 180
Me.lblMarqTask.Caption = ""
End Sub
Private Sub Form_Timer()
Static StrStatus_Lcl As String
If StrStatus_Lcl = "" Then
GetStatus
StrStatus_Lcl = StrStatus & Space(30)
If Me.lblMarqTask.Caption = "" Then Me.lblMarqTask.Caption = Space(Len(StrStatus_Lcl))
End If
Me.lblMarqTask.Caption = Right(Me.lblMarqTask.Caption, Len(Me.lblMarqTask.Caption) - 1) & Left(StrStatus_Lcl, 1)
StrStatus_Lcl = Right(StrStatus_Lcl, Len(StrStatus_Lcl) - 1)
End Sub
The result is the string scrolling will remain smooth the value get updates with each iteration.
To talk through what I have done here.
'Option Explicit' Is always good practice to have at the top of your modules/code, it forces you to declare your variables which can save you a headache in the future. This can be automatically added with new code object by enabling 'Require Variable Declaration' in 'Tools' > 'Options' of the VBA Developer environment (also known as the VBE).
Its not clear what the query was doing but to save on a loop I change it to return a single value that I could use. SELECT count([Task]) FROM [TblTasks] WHERE [Done] = 'No' will return a count of all items in TblTasks where the column Done equals No.
In format load I set the timer interval as this only needs setting once and I also ensured the marquee was empty before it run.
The timer keeps a local copy of the status that it remembers. Declaring with the word Static means the content of the variable is not lost between executions in the way a Dim declared variable would be.
If the local copy is empty (i.e. we have used it all up) then update what the status is (GetStatus) and get a new copy.
I hope this has been of help!