VBA statements for print only execute in debug mode - vba

strong textI have a simple word form that I want to print. I pass the printer name to a sub routine (myprint) in the variable oprinter. The variable printcomplete will pass back the name of the printer that was successful in printing the data.
This logic works when I am in debug mode but appears to bypass the print commands when not in debug. I have tried adding delays, I have added a MSGBOX after the print statement (prior to
printcomplete = oprinter > Exit Sub). The MSGBOX does display - so it should have executed the print statement. I do not get the msgbox under myprinterr.
Any idea why it won't print out of debug mode?
Here is my code:
'Print MS Word Form to one of three networked printers
Sub MyPrint(oprinter, printcomplete)
Dim sPrinter As String
On Error GoTo myprinterr
Sleep (5000)
With Dialogs(wdDialogFilePrintSetup)
sPrinter = .Printer
.Printer = oprinter
.DoNotSetAsSysDefault = True
.Execute
Sleep (5000)
Application.PrintOut FileName:=""
.Printer = sPrinter
.Execute
End With
Sleep (5000)
MSGBOX "Did it print? "
printcomplete = oprinter
Exit Sub
myprinterr:
MsgBox "oops printer error on: " & oprinter
End Sub

In the code I've noticed several lines of code:
CreateObject("Excel.Application").Wait (Now + TimeValue("00:00:05")) 'delay to try to get print to work when not in debug mode
There is no need to create a new Excel Application instance each time.
If you want to introduce any delay you can use the Sleep Windows API function instead. It suspends the execution of the current thread until the time-out interval elapses.

Related

The control could not be found by id. SAP GUI bug?

I am trying to automate SAP data extraction using scripting. The problem I am facing is a recorded script in SAP isn't working when I'm running it, when I use findById("id") method it comes out that cannot be found, however the tabs are there.
The idea is to move between the tabs (using session.findById("id").Select) to extract info in that panels. Use a list of Purchase Orders (PO's), make a loop and extract the information, it's simple.
However, these tabs aren't found randomly. Sometimes it works, sometimes it is not found. All PO's (if I do it manually) have tabs with the data, but in the script it doesn't work.
For example:
The red box is the tabs that I am trying to select
Output of the recorded script (just moving between tabs):
If Not IsObject(application) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set application = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(connection) Then
Set connection = application.Children(0)
End If
If Not IsObject(session) Then
Set session = connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject application, "on"
End If
session.findById("wnd[0]").resizeWorkingPane 183,24,false
session.findById("wnd[0]/usr/subSUB0:SAPLMEGUI:0015/subSUB3:SAPLMEVIEWS:1100/subSUB2:SAPLMEVIEWS:1200/subSUB1:SAPLMEGUI:1301/subSUB2:SAPLMEGUI:1303/tabsITEM_DETAIL/tabpTABIDT13").select
' Extract info
session.findById("wnd[0]/usr/subSUB0:SAPLMEGUI:0019/subSUB3:SAPLMEVIEWS:1100/subSUB2:SAPLMEVIEWS:1200/subSUB1:SAPLMEGUI:1301/subSUB2:SAPLMEGUI:1303/tabsITEM_DETAIL/tabpTABIDT15").select
' Extract info
session.findById("wnd[0]/usr/subSUB0:SAPLMEGUI:0015/subSUB3:SAPLMEVIEWS:1100/subSUB2:SAPLMEVIEWS:1200/subSUB1:SAPLMEGUI:1301/subSUB2:SAPLMEGUI:1303/tabsITEM_DETAIL/tabpTABIDT18").select
' Extract info
Error:
The control could not be found by id.
I'm using:
My theory, the tab is hidden and doesn't find it, that I would have to use the arrows to move, however when I use the arrows at the time of making the script recording, it simply doesn't add them to the code.
Sorry for my English, and thanks in advance for your time.
I can only offer a workaround on this phenomenon.
for example:
...
for i = 1 to 99
on error resume next
session.findById("wnd[0]/usr/subSUB0:SAPLMEGUI:00" & right("0" & cstr(i),2) & "/subSUB3:SAPLMEVIEWS:1100/subSUB2:SAPLMEVIEWS:1200/subSUB1:SAPLMEGUI:1301/subSUB2:SAPLMEGUI:1303/tabsITEM_DETAIL/tabpTABIDT13").select
if err.number = 0 then exit for
on error goto 0
next
on error goto 0
' Extract info
for i = 1 to 99
on error resume next
session.findById("wnd[0]/usr/subSUB0:SAPLMEGUI:00" & right("0" & cstr(i),2) & "/subSUB3:SAPLMEVIEWS:1100/subSUB2:SAPLMEVIEWS:1200/subSUB1:SAPLMEGUI:1301/subSUB2:SAPLMEGUI:1303/tabsITEM_DETAIL/tabpTABIDT15").select
if err.number = 0 then exit for
on error goto 0
next
on error goto 0
' Extract info
for i = 1 to 99
on error resume next
session.findById("wnd[0]/usr/subSUB0:SAPLMEGUI:00" & right("0" & cstr(i),2) & "/subSUB3:SAPLMEVIEWS:1100/subSUB2:SAPLMEVIEWS:1200/subSUB1:SAPLMEGUI:1301/subSUB2:SAPLMEGUI:1303/tabsITEM_DETAIL/tabpTABIDT18").select
if err.number = 0 then exit for
on error goto 0
next
on error goto 0
' Extract info
Regards,
ScriptMan
Ah yes, my favorite SAP screen: ME23N. Who knows what the SAPLMEGUI:00XX will be! But, if you find the element by it's name you'll never run into this problem. Additionally, this solves the problem of the tab you want not being there; because, depending on the line item of the PO, who knows what tabs will be available.
Here's how I get over this every time, without fail.
In your sub procedure use the function below. If the tab is there it will select it and return true and you can continue extracting your data. You need the tab text and the name of the tab strip.
You can find the name of the tab strip easily. Look at what has been recorded. It has the "tabs" prefix.
session.findById("wnd[0]/usr/subSUB0:SAPLMEGUI:0015/subSUB3:SAPLMEVIEWS:1100/subSUB2:SAPLMEVIEWS:1200/subSUB1:SAPLMEGUI:1301/subSUB2:SAPLMEGUI:1303/tabsITEM_DETAIL/tabpTABIDT13")
Public Sub Main()
If IsTabThere("ITEM_DETAIL", "Account Assignment") = True Then
' Extract info
End If
If IsTabThere("ITEM_DETAIL", "Purchase Order History") = True Then
' Extract info
End If
End Sub
Public Function IsTabThere(ByVal tabStripName As String, ByVal tabText As String) As Boolean
Dim userArea As Object
Dim tabStrip As Object
Dim tabToSelect As Object
Set userArea = session.FindById("wnd[0]/usr")
Set tabStrip = userArea.FindByName(tabStripName, "GuiTabStrip").Children
For Each tabToSelect In tabStrip
If tabToSelect.Text = tabText Then
tabToSelect.Select
IsTabThere = True
' Will exit here if the tab was selected and return true
Exit Function
End If
Next
IsTabThere = False
End Function
Hope this makes your day. Good luck!
If your interested in making your script more dynamic checkout my answer on this post. I explain how to get started using the SAP GUI Scripting API.
how-to-run-sap-gui-script-from-excel-macro

How to close a shelled application

I ran the following VBA code (in MS Word) in order to start Windows Calculator and perform some computations:
Dim RetVal, i
RetVal = Shell("C:\WINDOWS\CALC.EXE", 1) ' Run Calculator.
The code does some calculations and I input the information into a popup box. After I hit enter, the program automatically does some magical formatting and prints a form (I have no problems with that).
However, I can't figure out how to simply close the calculator that I just opened. I don't need it to test how many instances are open or whatever. Just close it. How to close an application I've shelled?
Edit: here's most of the macro:
Sub PageHeight()
Dim ReturnValue, i
ReturnValue = Shell("calc.exe", 1)
ActiveDocument.PageSetup.PageWidth = InchesToPoints(InputBox("Enter Page Width - 8.5 inches or less" & vbNewLine & "Do not enter the inches symbol.", xpos:=1440, ypos:=720))
ActivePrinter = "HP LaserJet P2055dn UPD PCL 6"
With Application
.DisplayAlerts = wdAlertsNone
.PrintOut Background:=False
.DisplayAlerts = wdAlertsAll
End With
End

Excel VBA: Force user to save as .xlsm

I have a series of macros that automates much of a process. I would like to distribute this to my coworkers via Excel Add-In and I have one piece of code I just can't seem to get right.
Here is the "master" code (which works fine):
Option Explicit
Sub MIUL_Run_All()
Dim StartTime As Double
Dim SecondsElapsed As String
'Remember time when macro starts
StartTime = Timer
Call OptimizeCode_Begin
Call Save_As
Call Format_MIUL
Call Custom_Sort_MIUL
Call Insert_Process_List
Call Format_Process_List
Call OptimizeCode_End
'Determine how many seconds code took to run
SecondsElapsed = Format((Timer - StartTime) / 86400, "ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds",
vbInformation
End Sub
The code that is giving me trouble is "Save_As". First thing I want the user to do is to save the file as a macro enabled file. Ideally, I want the code to do these things for the user:
Force the user to save as .xlsm
Provide the current file name in the Save As dialog box so they have a file name to already work with.
If the CANCEL button is pressed it must stop the entire macro!
I thought this would be a fairly trivial thing, but so far it has been the toughest part of my code.
Here is what I have tried for the Save_As code:
Application.Dialogs(xlDialogSaveAs).Show , xlOpenXMLWorkbookMacroEnabled
This code is very simple, but it doesn't address the cancel button.
Dim userResponse As Boolean
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(52)
On Error GoTo 0
If userResponse = False Then
Exit Sub
Else
End If
Again for some reason this doesn't address the cancel button.
I have tried probably a half a dozen different things, most of which are similar to the above codes.
Any help is appreciated.
You have this:
If FileDialog.Show = False Then
Exit Sub
End If
Which does not account for an error, simply recognizing a state. You will want the Exit Sub to happen if there's an error only.
This error handling could be implemented by replacing :
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(52)
On Error GoTo 0
If userResponse = False Then
Exit Sub
Else
End If
With:
On Error GoTo Cat
userResponse = Application.Dialogs(xlDialogSaveAs).Show(52)
Cat:
Exit Sub

Run Macro after Submitting Response in NO else Timer Complete

I come again with new query, I have made the Macro and assigned it on Workbook.open, now I want little bit changed, I want to prompt message BOX which have contains Do You want to Stop Macro ? Option YES and NO, If I clicked on Yes with in 10 seconds of workbook Open, I want to stay on same excel without executing the Macro; otherwise, run the macro if I clicked NO or if 10 seconds is completed.
VBA has a MsgBox function, but you cannot let that one time out like you want.
To get a prompt with time-out functionality, you could use the Popup method of the WScript.Shell object. You can create the Shell object with a CreateObject call, and see the MSDN documentation for the Popup method for more details on how to use it.
#Dharmendra Maybe you can try this code:
Private Sub Workbook_Open()
wbClose
End Sub
Sub wbClose()
Dim time As Integer, prompt As String
time = 10 'this is in seconds format
prompt = "This Workbook will close in " & time & " seconds." & _
vbLf & "Press OK if you want some changes to this Workbook."
With CreateObject("WScript.Shell")
Select Case .Popup(prompt, time, "Message", 0)
Case 1
Exit Sub
End Select
End With
ThisWorkbook.Close True
End Sub
Just do some revisions if you like. Thanks!

Excel is waiting for another application to complete an OLE action

Before you go for the obvious: Application.DisplayAlerts = False has not solved my problem.
I have written a VBA procedure (initiated in Excel 2010) which loops around an array containing different Excel files. The loop opens the file, refreshes the data, saves and closes the file for each item in the array. I have written an error catch sub routine so I log which excel files have failed to open/refresh/save etc so a user can manually check them.
Some files are quite large and involve a large amount of data moving across the network; sometimes I get a dialog box with: Excel is waiting for another application to complete an OLE action.
I could use Application.DisplayAlerts = False to disable the message but this would presumably disable all alerts so I couldn't catch the errors?
Further I have tested using the line and it doesn't stop the dialog box pop-up. If I press enter it carries on but will likely pop-up again a few minutes later.
Is there a way to stop is message specifically without stopping other alerts?
NB. My process has a control instance of Excel which runs the VBA and opens the workbooks to be refreshed in a separate instance.
Thanks for your help
An extract of my code is below which contains the refresh elements
Sub Refresh_BoardPivots_Standard()
' On Error GoTo Errorhandler
Dim i
Dim errorText As String
Dim x
Dim objXL As Excel.Application
Set objXL = CreateObject("Excel.Application")
GetPivotsToRefresh ' populate array from SQL
For Each i In StandardBoardPiv
DoEvents
'If File_Exists(i) Then
If isFileOpen(i) = True Then
errorText = i
Failed(failedIndex) = errorText
failedIndex = failedIndex + 1
Else
objXL.Visible = True 'False
objXL.Workbooks.Open FileName:=i
If objXL.ActiveWorkbook.ReadOnly = False Then
BackgroundQuery = False
Application.DisplayAlerts = False
objXL.ActiveWorkbook.RefreshAll
objXL.Application.CalculateFull
objXL.Application.DisplayAlerts = False
objXL.ActiveWorkbook.Save
objXL.Application.DisplayAlerts = True
objXL.Quit
Else
errorText = i
Failed(failedIndex) = errorText
failedIndex = failedIndex + 1
objXL.Application.DisplayAlerts = False
objXL.Quit
Application.DisplayAlerts = True
End If
End If
' Else
' errorText = i
' Failed(failedIndex) = errorText
' failedIndex = failedIndex + 1
' End If
DoEvents
If Ref = False Then
Exit For
End If
Next i
Exit Sub
'Errorhandler:
'
'errorText = i
'Failed(failedIndex) = errorText
'failedIndex = failedIndex + 1
'Resume Next
End Sub
"Waiting for another application to complete an OLE action" isn't an alert message you can just turn off and forget, sometimes the macro will be able to continue on after, but in my experience if you are getting that error its only a matter of time until the problem crashes/freezes your whole macro so it should definitely be troubleshot and corrected.
I only get that error when I am using additional Microsoft Office Applications (other than the Excel that is running the code) as objects and one of them has an error- the Excel running the code doesn't know that an error occurred in one of the other applications so it waits and waits and waits and eventually you get the "Waiting for another application to complete an OLE action" message...
So to troubleshoot this sort of problem you got to look for the places you use other MSO apps... In your example, you have an additional instance of Excel and you are pulling data from Access, so its most likely one of those two that is causing the problems...
Below is how I would re-write this code, being more careful with where the code interacts with the other MSO apps, explicitly controlling what is happening in them.. The only piece I couldn't really do much is GetPivotsToRefresh because I cant see what exactly youre doing here, but in my code I just assumed it returned an array with a list of the excel files you want to update. See code below:
Sub Refresh_BoardPivots_Standard()
Dim pivotWB As Workbook
Dim fileList() As Variant
Dim fileCounter As Long
Application.DisplayAlerts = False
fileList = GetPivotsToRefresh 'populate array from SQL
For fileCounter = 1 To UBound(fileList, 1)
Set pivotWB = Workbooks.Open(fileList(fileCounter, 1), False, False)
If pivotWB.ReadOnly = False Then
Call refreshPivotTables(pivotWB)
pivotWB.Close (True)
Else
'... Error handler ...
pivotWB.Close (False)
End If
Next
End Sub
Public Sub refreshPivotTables(targetWB As Workbook)
Dim wsCounter As Long
Dim ptCounter As Long
For wsCounter = 1 To targetWB.Sheets.Count
With targetWB.Sheets(wsCounter)
If .PivotTables.Count > 0 Then
For ptCounter = 1 To .PivotTables.Count
.PivotTables(ptCounter).RefreshDataSourceValues
Next
.Calculate
End If
End With
Next
End Sub
So I created my own 'refreshPivotTables' but you could have embedded that into the master sub, I just thought the loops and loop counters might get a little messy at that point...
Hope this helps,
TheSilkCode