Speeding up Macros

[namgc2]

Hi,

I use a lot of Macros to put large quantities of data into a Mainframe session. I have discovered (by Accident) that right clicking while any of the Macros are running that the macro runs about 3 times faster. The same thing happens when I press Alt H. Does anyone know what slows the system down in the first place and if there's some code I should add or remove to enable the Macros to run faster without having to right click.

Thanks

 

[Molby]

Can you post the code that you've got?

 

[namgc2]

Hi,

Here's some code for one of the simpler macros we use.

Any feedback or help would be appreciated.

Thanks


Global g_HostSettleTime%
Global g_szPassword$

Sub Main()

'--------------------------------------------------------------------------------
' Get the main system object
Dim Sessions As Object
Dim System As Object
Set System = CreateObject("EXTRA.System") ' Gets the system object
If (System is Nothing) Then
Msgbox "Could not create the EXTRA System object. Stopping macro playback."
STOP
End If
Set Sessions = System.Sessions
If (Sessions is Nothing) Then
Msgbox "Could not create the Sessions collection object. Stopping macro playback."
STOP
End If
'--------------------------------------------------------------------------------
' Set the default wait timeout value
g_HostSettleTime = 10 ' milliseconds
OldSystemTimeout& = System.TimeoutValue
If (g_HostSettleTime > OldSystemTimeout) Then
System.TimeoutValue = g_HostSettleTime
End If
' Get the necessary Session Object
Dim Sess0 As Object
Set Sess0 = System.ActiveSession
If (Sess0 is Nothing) Then
Msgbox "Could not create the Session object. Stopping macro playback."
STOP
End If
If Not Sess0.Visible Then Sess0.Visible = TRUE
Sess0.Screen.WaitHostQuiet(g_HostSettleTime)

' This section of code contains the recorded events
Sess0.Screen.Sendkeys("<Home>")

Sess0.Screen.WaitHostQuiet(g_HostSettleTime)

on error goto errhandler

Dim filerec As String * 4
Dim branch As String * 5

dim strinp as string
dim innerloop as integer
Dim intloop As Integer
dim fname as string
dim strtest as object
dim rtest as object
dim branerr as string
dim totcount
dim flag as integer

' ***** Check if user has the correct Branch group Screen in BD *****

set strtest = sess0.screen.area(3,29,3,49)

if strtest<>"MAINTAIN BRANCH GROUP" then
msgbox" Incorrect Screen. ",16," Screen Error"
exit sub
end if
' ******

retry:

on error goto errhandler
close

innerloop=1
strinp="a"
intloop = 1
totcount=0




ChDir "p:\"
branerr=""
flag=0
fname=inputbox("Please enter a filename to script in a branch group (PRESS ENTER TO USE brangrp.txt) ","Filename Input","Brangrp.txt")

if fname="" then
exit sub
end if
if right(fname,3) <> "txt" then
fname=fname & ".txt"
end if

Open fname For input As #1
Sess0.Screen.Sendkeys("<Home>")
Sess0.Screen.Sendkeys("<Tab>")
For intloop = 1 To 48
Sess0.Screen.Sendkeys("<EraseEOF><Tab>")
next intloop

Sess0.Screen.Sendkeys("<Home>")
Sess0.Screen.Sendkeys("<Tab>")
Do
input #1, filerec
branch = Mid(filerec, 1, 4)

Sess0.Screen.putstring strinp
Sess0.Screen.Sendkeys("<Tab>")
Sess0.screen.putstring branch
Sess0.Screen.Sendkeys("<Tab>")
innerloop=innerloop+1
totcount=totcount+1
If innerloop=25 then
sess0.screen.sendkeys("<enter>")
Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
do while sess0.screen.oia.xstatus<>0
clear=sess0.screen.oia.xstatus
loop
for intloop = 1 to 12
set strtest = sess0.screen.area(8+intloop,6,8+intloop,38)
set rtest = sess0.screen.area(8+intloop,48,8+intloop,66)
if mid(strtest,8,12)="BRANCH DESC." then
flag=1
' branerr= branerr & mid(strtest,1,4) & ", "

end if

if mid(rtest,8,12)="BRANCH DESC." then
flag=1
'branerr=branerr & mid (rtest,1,4) & ", "
end if
next intloop
set strtest = sess0.screen.area(9,3,9,3)



Sess0.Screen.Sendkeys("<Home>")
Sess0.Screen.Sendkeys("<Tab>")
innerloop=1
For intloop = 1 To 48
Sess0.Screen.Sendkeys("<EraseEOF><Tab>")
next intloop
Sess0.Screen.Sendkeys("<Home>")
Sess0.Screen.Sendkeys("<Tab>")
End If

Loop Until EOF(1) = True
sess0.screen.sendkeys("<enter>")
Sess0.Screen.WaitHostQuiet(g_HostSettleTime)
do while sess0.screen.oia.xstatus<>0
clear=sess0.screen.oia.xstatus
loop
for intloop = 1 to 12
set strtest = sess0.screen.area(8+intloop,6,8+intloop,38)
set rtest = sess0.screen.area(8+intloop,48,8+intloop,66)
if mid(strtest,8,12)="BRANCH DESC." then
flag=1
' branerr= branerr & mid(strtest,1,4) & ", "

end if
'msgbox rtest
'msgbox mid(rtest,8,12)
if mid(rtest,8,12)="BRANCH DESC." then
flag=1
'branerr=branerr & mid (rtest,1,4) & ", "
end if
next intloop
Close

if flag=0 then
msgbox "total number of branches added to Branch Group =" & totcount
else
msgbox "Total number of branches added to Branch Group =" & totcount & " !!! Be aware that at least 1 branch number was incorrect and failed to be added to the Branch group !!!"
end if

oname = "G:\Stock Control Services\Attachmate Macros\macroaudit.txt"
macroname = "Branch Group"

index%=1

Do
user1=environ(index%)
if left$(user1, 9) = "USERNAME=" then
who=environ(index%)
'msgbox mid(user2, 10,4)
exit do
else
index% = index%+1
end if
loop until user1 = ""
'who2 = mid(who, 10,4)
'who =environ(46)
when = Date
rtime = Time
ostring = mid(who, 10,4) & "," & macroname & "," & "N/A" & "," & totcount & "," & when & " " & rtime
Open oname For append As #2
print #2, ostring
close #2




System.TimeoutValue = OldSystemTimeout

exit sub
errhandler:

select case err
case 53:msg$="File does not exist."
case 75:msg$="Access error."
case 76:msg$="Path not found."
end select

answer=msgbox(msg$,37,"Problem with file")

select case answer
case 2:exit sub
case 4:resume retry

end select




End Sub

 

[Skie]

You could write a script to set the priority to Above Normal or High for the task. I have no idea why a right-click or Alt+H would cause it to run faster.

 

[namgc2]

Hi,

I have no idea how to set the priority to high. Any advice or help with the code would be great !

Thanks

 

[Skie]

You need to change the for each loop to a normal for loop to make it work in EB. I don't know if you can just do an for i = 1 (maybe 0) to cProcs.Count. I've always called my EB code with a VBScript and set the priority there.

const ABOVE_NORM = 32768
set oWMIService = GetObject("winmgmts:" & _
  {impersonationLevel=impersonate}!\\.\root\cimv2")
set cProcs = oWMIService.ExecQuery("Select * from Win32_Process " & _
  "Where Name = 'ebrun.exe'")
For Each oProc In cProcs
  oProcs.SetPriority(ABOVE_NORM)
Next

Word has a task manager that you could try using too. I don't know if you can set the priority with this.

Set oWord = CreateObject("Word.Application")
Set cTasks = oWord.Tasks

For Each oTask in cTasks
    Wscript.Echo oTask.Name
Next

oWord.Quit

 

[ChrisWhite123]

I have found that when running any mainframe data collection macro's within Attachmate, if you click on one of the options from the Windows menu and allowing drop down menu to display, the speed doubles at least ..... Why???????