I am trying to extract a PDF document from SAP, however, I am stuck with the second part of the code where I need to initiate the Save As sequence.
The first part of the code involves connecting to SAP and querying specific invoice number, followed by a few lines of code where I am trying to attach to the second SAP window containing the PDF document. The trick is using the Send Keys to save the actual file.
Sub DocumentExtraction()
Dim varResponse As Variant 'Prompts the user if macro should be run.
varResponse = MsgBox("Are you sure you wish to run extraction macro?", vbYesNo, "Warning!")
If varResponse <> vbYes Then Exit Sub
Set SapGuiAuto = GetObject("SAPGUI") 'Obtains SAP GUI Scripting object.
Set SAPApp = SapGuiAuto.GetScriptingEngine 'Obtains currently running SAP GUI.
Set SAPCon = SAPApp.Children(0) 'Obtains the first system currently connected.
Set session = SAPCon.Children(0) 'Obtains the first session (window) on that connection.
' SAP scripting starts here.
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").Text = "/nFB03"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/txtRF05L-BELNR").Text = "930502016"
session.findById("wnd[0]/usr/ctxtRF05L-BUKRS").Text = "7360"
session.findById("wnd[0]/usr/txtRF05L-GJAHR").Text = "2019"
session.findById("wnd[0]/usr/txtRF05L-GJAHR").SetFocus
session.findById("wnd[0]/usr/txtRF05L-GJAHR").caretPosition = 4
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/titl/shellcont/shell").pressContextButton "%GOS_TOOLBOX"
session.findById("wnd[0]/titl/shellcont/shell").selectContextMenuItem "%GOS_VIEW_ATTA"
session.findById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell").selectedRows = "0"
session.findById("wnd[1]/usr/cntlCONTAINER_0100/shellcont/shell").doubleClickCurrentCell
Set session = SAPCon.Children(1) 'Obtains the second session (window) on current connection.
session.findById("wnd[0]/shellcont/shell/shellcont[1]/shell").SetFocus
End Sub
I have found a similar post on the SAP support page, however, the suggested solution does not seem to work - an object does not exist.
An easy workaround was to disable Adobe PDF Reader in Internet Explorer by navigating to Internet Explorer/Tools/Internet Options/Programs/Manage add-ons/select All add-ons/disable Adobe PDF Reader.
Then use the code below after clicking on the document and it opens the open/save/close window.
Application.Wait Now + TimeValue("0:00:15")
SendKeys "%s" 'ALT + S initiates save as procedure.
Application.Wait Now + TimeValue("0:00:05")
SendKeys ExtractFolderPath & ExtractFileName 'File name and path are entered.
Application.Wait Now + TimeValue("0:00:02")
SendKeys "{ENTER}"
Application.Wait Now + TimeValue("0:00:02")
SendKeys "{F3}" 'Closes Document Viewer window.
Application.Wait Now + TimeValue("0:00:02")
session.findById("wnd[1]").Close 'Closes Attachment List window.
Related
The following VBA code gets stuck at the While loop:
Sub SaveAsText2(MyMail As MailItem)
' Export email (with PowerShell script in body) as a text file
MyMail.SaveAs "c:\scripts\outlook.ps1", olTXT
' Create a response email
Dim reMail As Outlook.MailItem
Set reMail = MyMail.Reply
' wait till transcript is available
Dim MyFSO As FileSystemObject
Set MyFSO = New FileSystemObject
If MyFSO.FileExists("C:\Scripts\email_transcript.txt") Then
' This bit works correctly
' MsgBox "The file Exists"
Else
' This bit works correctly as well
' MsgBox "The file Does Not Exist"
End If
' This part fails to evaluate regardless if the file is there or not
While Not MyFSO.FileExists("C:\Scripts\email_transcript.txt")
' WScript.Sleep 1000
Application.Wait (Now + TimeValue("0:00:01"))
MsgBox "The file Does Not Exist"
Wend
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\scripts\testfile.txt", True)
a.WriteLine ("This is a test.")
a.Close
' attach the transcript and send it back
reMail.Attachments.Add "C:\Scripts\email_transcript.txt"
reMail.Send
MyFSO.DeleteFile ("C:\Scripts\email_transcript.txt")
End Sub
If the email_transcript.txt file exists, then the While loop gets skipped (which is correct) and the rest of the script runs. No issues here.
If the email_transcript.txt file does NOT exist, then the While loop will wait until the file exists. However, even when the file exists at this point, the While loop never validates and therefore it doesn't process the rest of the script.
The MsgBox in the While loop doesn't trigger when the file does NOT exist.
The MsgBox call stops any code execution until it is closed:
' This part fails to evaluate regardless if the file is there or not
While Not MyFSO.FileExists("C:\Scripts\email_transcript.txt")
' WScript.Sleep 1000
Application.Wait (Now + TimeValue("0:00:01"))
MsgBox "The file Does Not Exist"
Wend
Try to replace it with a Debug.Print statements, so the loop could continue:
' This part fails to evaluate regardless if the file is there or not
While Not MyFSO.FileExists("C:\Scripts\email_transcript.txt")
' WScript.Sleep 1000
Application.Wait (Now + TimeValue("0:00:01"))
Debug.Print "The file Does Not Exist"
Wend
The While/Wend structure has a logic fail: if at the moment of the first evaluation the expected file yet don't exists, the MsgBox alert will be fired, even if in the next second the file became properly saved.
You can change this as follows:
lngTimer = Timer
Do
DoEvents
Application.Wait (Now + TimeValue("0:00:01"))
If Timer > lngTimer + 10 Then Exit Do
Loop Until MyFSO.FileExists("C:\Scripts\email_transcript.txt") = True
Using a Do/Loop structure with a 'scape valve' of a Timer comparison will ensure a correct check for the file's existence, avoiding an eternal loop. Adapt the timeout parameter for the file to be saved (10 in the example).
Fixed the issue. It's to do with Application.Wait, which doesn't work in Outlook. Solution is here:
Wait for 5-10 seconds then run Outlook code
Sub SaveAsText2(MyMail As MailItem)
' Export email (with PowerShell script in body) as a text file
MyMail.SaveAs "c:\scripts\outlook.ps1", olTXT
' Create a response email
Dim reMail As Outlook.MailItem
Set reMail = MyMail.Reply
' wait till transcript is available
Dim MyFSO As FileSystemObject
Set MyFSO = New FileSystemObject
While Not MyFSO.FileExists("C:\Scripts\email_transcript.txt")
Sleep 1
Wend
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\scripts\testfile.txt", True)
a.WriteLine ("This is a test.")
a.Close
' attach the transcript and send it back
reMail.Attachments.Add "C:\Scripts\email_transcript.txt"
reMail.Send
MyFSO.DeleteFile ("C:\Scripts\email_transcript.txt")
End Sub
Public Sub Sleep(ByVal SleepSeconds As Single)
Dim Tmr As Single
Tmr = Timer
Do While Tmr + SleepSeconds > Timer
DoEvents
Loop
End Sub
I'm one step away from success on a huge automation project. I've got a dynamic download automated all the way up to the IE11 Save As dialogue box. This is where I'm stuck. I need to 1) enter in a dynamic file name and save to a dynamic folder (all based on a cell value). 2) click Save while overriding any update dialogue boxes
Limitations; I cant download based on the URL if you were going to suggest that. I'm dealing with a secure site and a funky URL that can only be accessed via the For Next loop I have below. I'm limited to dealing with this SaveAs box as far as I'm aware.
Here's what I have so far;
Sub savedownload()
Dim objIE As InternetExplorer
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.navigate Sheet3.Range("A1").Value ' this is where the dynamic URL is updated
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
objIE.document.getElementById("PrintFormat").Value = "Pdf"
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Dim list As Object, item As Object
Set list = objIE.document.getElementsByTagName("a")
For Each item In list
If item.innerText = "Export" Then
item.Click
Exit For
End If
Next
Application.Wait (Now + TimeValue("0:00:05"))
Application.SendKeys "{TAB}", True
Application.SendKeys "{TAB}", True
Application.SendKeys "{DOWN}", True
Application.SendKeys "{DOWN}", True
Application.SendKeys "{RETURN}", True
'this is where the dialoge box comes up, but I cant seem to send a dynamic string of text to the file name/path field
End Sub
I have attached a screenshot as well. Would send keys work? Is there a way to call the SaveAs window and drop in a dynamic file name? I can throw a file name at it and get it to save with SendKeys, but I'm thinking there's a better way where I can send an entire dynamic String to the FileName field in the dialogue box.
Thanks for any suggestions.
Screenshot of IE11 SaveAs dialogue box
I currently am running some VBA to navigate an intranet site, perform some actions, etc. I have completed the actions I need to take, and now I have 2 IE windows open. One window, my original, I want to remain open. The second window, I want to close.
I have been having issues closing the second window. Using simple SendKeys "%{F4}" doesn't close the window at all, although it would if I did the steps manually rather than through VBA. Also, ieApp.Quit keeps closing the first IE window, which I want to remain open to use again. Which is strange because it isn't the active window at the time.
My question is...is there a way to find/select an open IE window based on a partial URL? I know the URL will start with http://ctdayppv02/PVEShowDocPopup.aspx? but everything after that will change each time.
I've seen plenty online about launching IE with a URL, or returning the URL of an already open IE instance, but I'm not trying to do either of those at this point. I just want to activate a specific open IE window, so then I can close that one only.
Here is part of my code, which isn't closing anything as of now, but also doesn't result in any errors. It's the very last part that doesn't work, everything else is good.:
'***** Click the Search button *****
ieApp.Document.all.Item("btnSubmitProjectSearch").Click: DoEvents: Sleep 1000
'***** Click the Print button *****
ieApp.Document.all.Item("printLink").Click: DoEvents: Sleep 1000
'***** Setting variables for Windows API. Will be used to find the proper windows box by name *****
Dim windowHWND As LongPtr
Dim buttonHWND As LongPtr
Dim hwnd As String
Dim hwindow2 As String
''***** Will click the Print button. MUST HAVE MICROSOFT PDF AS DEFAULT PRINTER *****
windowHWND = getWindowPointer("Print", "#32770")
If windowHWND > 0 Then
'***** Add a small delay to allow the window to finish rendering if needed *****
Sleep 250
buttonHWND = FindWindowEx(windowHWND, 0, "Button", "&Print")
If buttonHWND > 0 Then
SendMessage buttonHWND, BM_CLICK, 0, 0
Else
Debug.Print "didn't find button!"
End If
End If
'***** Locate the "Save Print Output As" window, enter the filepath/filename and press ENTER *****
hwnd = FindWindow(vbNullString, "Save Print Output As")
Do
DoEvents
hwindow2 = FindWindow(vbNullString, "Save Print Output As")
Loop Until hwindow2 > 0
SendKeys "C:\Users\NAME\Documents\" & Range("G2").Value
SendKeys "{ENTER}"
'***** Locate the Viewer Control box that appears after saving and press ENTER to advance *****
hwnd = FindWindow(vbNullString, "PaperVision Document Viewer Control")
Do
DoEvents
hwindow2 = FindWindow(vbNullString, "PaperVision Document Viewer Control")
Loop Until hwindow2 > 0
SendKeys "{Enter}"
'***** Locate the "PaperVision - View Document" IE window and close it *****
hwnd = FindWindow(vbNullString, "PaperVision - View Document - Internet Explorer")
Do
DoEvents
hwindow2 = FindWindow(vbNullString, "PaperVision - View Document - Internet Explorer")
Loop Until hwindow2 > 0
'ieApp.Quit
SendKeys "%{F4}"
Any advice on how to close just that one page? Thanks in advance!
As per the first suggestion by QHarr, try...
Option Explicit
Sub test()
Dim oShell As Object
Dim oShellWindows As Object
Dim oShellWindow As Object
Dim sPartialURL As String
sPartialURL = "http://ctdayppv02/PVEShowDocPopup.aspx?"
Set oShell = CreateObject("Shell.Application")
Set oShellWindows = oShell.Windows
For Each oShellWindow In oShellWindows
If oShellWindow.Name = "Internet Explorer" Then
If InStr(oShellWindow.Document.URL, sPartialURL) > 0 Then
Exit For
End If
End If
Next oShellWindow
If Not oShellWindow Is Nothing Then
'Do stuff
'
'
oShellWindow.Quit
Else
MsgBox "The specified Internet Explorer window was not found!", vbExclamation
End If
Set oShell = Nothing
Set oShellWindows = Nothing
Set oShellWindow = Nothing
End Sub
I like Domenic's response more, but I wanted to post another way I came across online for anybody who may be looking at this down the road and wants another method.
This way uses a function that is called in the primary sub. The "View Document" is the wording that appears in the IE window caption, NOT in the URL. This will close any IE that contains that specific phrase somewhere in the window caption. I only tested this a few times but it seems to work.
Sub CloseWindow()
Do Until Not CloseIeIf("View Document"): Loop
End Sub
Function CloseIeIf(Str As String) As Boolean
Dim ie As Object
For Each ie In CreateObject("Shell.Application").Windows
If InStr(ie.LocationName, Str) <> 0 Then
ie.Quit
CloseIeIf = True
End If
Next
End Function
This question seems to have been asked dosens of times, however none of the solutions I have found seem to be able to solve my problem.
As the webpage is using a certificate token I am forced to log on to the webpage manually before I can activate the VBA script, which is no problem. An important note is that the link to the report is dynamic and therefore I cannot link directly to the report itself and therefore I have to navigate the webpage with my Script. Below you find the script i am using to locate the window I have logged on to the webpage with:
Sub WebPageOpen()
Dim HTMLDoc As HTMLDocument
Dim oHTML_Element As IHTMLElement
On Error GoTo Err_Clear
Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For X = 0 To (IE_count - 1)
On Error Resume Next ' sometimes more web pages are counted than are open
my_url = objShell.Windows(X).document.Location
my_title = objShell.Windows(X).document.Title
If my_title Like "MY Webpage name" Then 'compare to find if the desired web page is already open
Set IE = objShell.Windows(X)
marker = 1
Exit For
Else
End If
Next
If marker = 0 Then
MsgBox ("Webpage is not open - Please log on to webpage")
Exit Sub
Else
End If
Do
' Wait till the Browser is loaded
Loop Until IE.readyState = READYSTATE_COMPLETE
' I have removed all my navigation commands here,as it would just be bloating the query. It clicks the link and the Save/open ribbon appears in IE.
End sub
Can anyone help me with some sort of solution to how I can interact with the Open/Save as ribbon which appears when I download the file?
That ribbon is called Notification bar.
You can use Alt+N to focus on the Notification Bar. And then send {tab} key to navigate to the specific button.
With VBA, you may use Autohotkey.dll or AutoItX3.dll to send these hotkey combinations.
Add reference to AutoItX3.dll (for both 32-bit and 64-bit OS)
Append the following
set X=CreateObject("AutoItX3.Control")
X.send !N{tab}{down 2}{enter} 'This is for Save-as
I want to read web pages using Excel VBA. How do I carry out this task? Is it even possible?
Coming from Excel 2003, yes this is possible - you may use the SHDocVw.InternetExplorer and MSHTML.HTMLDocument objects to call a web page, gain control over and interact with the DOM object. After creating references to Microsoft HTML Object Library (...\system32\MSHTML.TLB) and Microsoft Internet Control (...\system32\ieframe.dll) you can play with the following example:
Sub Test()
Dim Browser As SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Set Browser = New SHDocVw.InternetExplorer ' create a browser
Browser.Visible = True ' make it visible
Application.StatusBar = ".... opening page"
Browser.navigate "http://www.google.com" ' navigate to page
WaitForBrowser Browser, 10 ' wait for completion or timeout
Application.StatusBar = "gaining control over DOM object"
Set HTMLDoc = Browser.document ' load the DOM object
WaitForBrowser Browser, 10
' at this point you can start working with the DOM object. Usefull functions are
' With HTMLDoc
' .getElementByID(string)
' .getElementsByTagName(string)
' .getElementsByName(string)
' .getAttribute(string)
' .setAttribute string, string .... to change field values, click a button etc.
' End With
Application.StatusBar = "" ' time to clean up
Browser.Quit
Set HTMLDoc = Nothing
Set Browser = Nothing
End Sub
Sub WaitForBrowser(Browser As SHDocVw.InternetExplorer, Optional TimeOut As Single = 10)
Dim MyTime As Single
MyTime = Timer
Do While Browser.Busy Or (Timer <= MyTime + TimeOut)
DoEvents
Loop
' if browser still busy after timeout, give up
If Browser.Busy Then
MsgBox "I waited for " & Timer - MyTime & " seconds, but browser still busy" & vbCrLf & _
"I give up now!"
End
End If
End Sub
You can use VBA to automate IE (plenty of examples via Google) or you can fetch the page directly using an instance of MSHTTP (ditto plenty of examples on the web). Which is best for your needs will depend on exactly what you want to do. Hard to say more without more detailed requirements.