Sending an image in whatsapp web using VBA - vba

Does someone know how to add a picture in an whatsapp web conversation using VBA?
Preferably not as an attachment, but directly in the message.
I've reached a point where the code gets me to open the whatsapp web url, finds the contact to which I want to send the message and places the cursor in the message box, but I couldn't find out yet how to paste the image i've copied or even how to attach a picture inside my machine.
As the image I want to paste and send is a print of some of the worksheet's cells, when I write the code as to make it run "ctrl v" it pastes as a text, not as an image as I want.
My code so far:
Sub Send_whats()
Sheets("Current summary").Select
Dim text As String
Dim contact As String
text = "Hi! Here goes a summary of your order"
contact = Cells(6, 3)
If contact = "" Then
MsgBox "Attention, contact is blank!"
Exit Sub
End If
Range("A1:H26").Copy
ActiveWorkbook.FollowHyperlink Address:="https://web.whatsapp.com/"
Application.Wait (Now + TimeValue("0:00:07"))
Call SendKeys("{TAB}", True)
Application.Wait (Now + TimeValue("0:00:05"))
Call SendKeys(contact, True)
Application.Wait (Now + TimeValue("0:00:03"))
Call SendKeys("{TAB}", True)
Application.Wait (Now + TimeValue("0:00:02"))
Call SendKeys("{TAB}", True)
Application.Wait (Now + TimeValue("0:00:02"))
Call SendKeys("{TAB}", True)
Application.Wait (Now + TimeValue("0:00:03"))
Call SendKeys("^(V)", True) 'here is where it goes wrong!
Application.Wait (Now + TimeValue("0:00:03"))
Call SendKeys(text, True)
Application.Wait (Now + TimeValue("0:00:03"))
Call SendKeys("Enter", True)
End Sub
I appreciate any help! Thanks!

Related

Printing from SAP via VBA

I have a script I put together that completes bulk shipments in SAP via VBA. At the end of each completed shipment, I want SAP to print the completed page as confirmation.
Sub STOMacro()
Dim App, Connection, session As Object
Set SapGuiAuto = GetObject("SAPGUI")
Set App = SapGuiAuto.GetScriptingEngine
Set Connection = App.Children(0)
Set session = Connection.Children(0)
If session Is Nothing Then
Set session = Connection.Children(Int(ses))
End If
If MsgBox("Are you sure you want to acknowledge these STOs?", vbYesNo, "Complete STOs?") = vbNo Then
Exit Sub
End If
OrderCounter = Range("A:A").Find("*", Range("A64999"), xlValues, xlWhole, xlByRows, xlPrevious).Row
For i = 1 To OrderCounter
Application.DisplayAlerts = False
STO = Range("A" & i).Value
Application.StatusBar = "Acknowledging STO " & i & " out of " & OrderCounter
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").Text = "/nzvmonitor"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/tbar[1]/btn[17]").press
session.findById("wnd[1]/usr/txtV-LOW").Text = "STOPrint"
session.findById("wnd[1]/usr/txtENAME-LOW").Text = ""
session.findById("wnd[1]/usr/txtV-LOW").CaretPosition = 14
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[0]/usr/ctxtS_DLVRY-LOW").Text = "" & STO & ""
session.findById("wnd[0]/usr/ctxtS_DLVRY-LOW").SetFocus
session.findById("wnd[0]/usr/ctxtS_DLVRY-LOW").CaretPosition = 10
session.findById("wnd[0]").sendVKey 8
session.findById("wnd[0]/usr/cntlZVR_OMONITOR_C1/shellcont/shell").currentCellColumn = ""
session.findById("wnd[0]/usr/cntlZVR_OMONITOR_C1/shellcont/shell").selectedRows = "0"
session.findById("wnd[0]/usr/cntlZVR_OMONITOR_C1/shellcont/shell").pressToolbarButton "RCPT"
session.findById("wnd[0]").sendVKey 3
session.findById("wnd[1]/usr/btnBUTTON_1").press
session.findById("wnd[1]").sendVKey 0
session.findById("wnd[0]/usr/cntlZVR_OMONITOR_C1/shellcont/shell").pressToolbarButton "&PRINT_BACK"
session.findById("wnd[1]").sendVKey 0
session.findById("wnd[1]").sendVKey 13
'This is where the print dialogue pops up but I can't interact with it
Next i
MsgBox ("All STOs acknowledged and printed.")
Application.StatusBar = ""
End Sub
I can get SAP to open the print dialogue box but the user still has to manually click "ok" in order to actually print the pages. This is a minor inconvenience but I was wondering if it could.
Print dialogue
If anything, I'm fine with just using SendKeys to make the print dialogue get {Enter} sent to it but I don't know how to make SAP hook onto the box to send that command.
For many years we have been using the following program code in a similar place:
. . .
dim Wshell as Object
set Wshell = CreateObject("WScript.Shell")
on error resume next
Do
bWindowFound = Wshell.AppActivate("Print")
Application.Wait (Now + TimeValue("0:00:01"))
Loop Until bWindowFound
bWindowFound = Wshell.AppActivate("Print")
if (bWindowFound) Then
Wshell.appActivate "Print"
Application.Wait (Now + TimeValue("0:00:01"))
Wshell.sendkeys "{ENTER}"
end if
bWindowFound = Wshell.AppActivate("Print")
if (bWindowFound) Then
Wshell.appActivate "Print"
Application.Wait (Now + TimeValue("0:00:01"))
Wshell.sendkeys "{TAB}{ENTER}"
end if
bWindowFound = Wshell.AppActivate("Print")
if (bWindowFound) Then
Wshell.appActivate "Print"
Application.Wait (Now + TimeValue("0:00:01"))
Wshell.sendkeys "{TAB}{TAB}{ENTER}"
end if
'It could be superfluous under certain circumstances.
session.findById("wnd[1]").Close
Application.Wait (Now + TimeValue("0:00:01"))
on error goto 0
. . .
However, since you can not know where the cursor is currently located, all possibilities are carried out. But if you know it, you could leave something out.
Regards,
ScriptMan

Log-in to Website

I'm trying to create an Excel macro that will log me into this website. I've written macros to log me into to other websites, but this one is somehow different.
When I use the following code to programmatically insert the username and password and then programmatically click the "log-in" button, the webpage comes back with the message
Error: please provide a username and Error: Please provide a
password
Sub LogIn()
' Open IE and navigate to the log-in page
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.navigate "https://www.prudential.com/login"
' Loop until the page is fully loaded
Do Until Not ie.Busy And ie.ReadyState = 4
DoEvents
Loop
Application.Wait (Now + TimeValue("0:00:10"))
' Enter the necessary information on the Login web page and click the submit button
ie.document.getElementById("username").Value = "abcdef"
ie.document.getElementById("password").Value = "12345678"
ie.document.getElementsByClassName("btn btn-primary btn-login btn-sm-block analytics-login")(0).Click
' Loop until the page is fully loaded
Do Until Not ie.Busy And ie.ReadyState = 4
DoEvents
Loop
End With
' Do stuff
' Quit IE
ie.Quit
End Sub
I can see that my code has inserted the username and password into the webpage boxes, but for some reason after successfully clicking the submit button, the username and password are not being detected.
What code will successfully insert the username and password so that it can be processed by the web page? You'll know that your code works when you get the following error message:
We are unable to verify your username and password. Please try again.
Thanks for your help!
It actually wants you to send a key, so you can bypass this request like this:
ie.document.getElementById("username").Focus
ie.document.getElementById("username").Value = "abcde"
Application.SendKeys "f", True
ie.document.getElementById("password").Focus
ie.document.getElementById("password").Value = "1234567"
Application.SendKeys "8", True
ie.document.getElementsByClassName("btn btn-primary btn-login btn-sm-block analytics-login")(0).Click
Edit:
Sub GetData()
Dim ie As InternetExplorer
Dim desc As IHTMLElement
Set ie = New InternetExplorer
With ie
.navigate "https://www.prudential.com/login"
.Visible = True
End With
Do While (ie.Busy Or ie.ReadyState <> READYSTATE_COMPLETE)
DoEvents
Loop
ie.document.getElementById("username").Focus
Application.SendKeys "abcdef"
Application.Wait (Now + TimeValue("0:00:01"))
ie.document.getElementById("password").Focus
Application.SendKeys "12345678"
Application.Wait (Now + TimeValue("0:00:01"))
ie.document.getElementsByClassName("btn btn-primary btn-login btn-sm-block analytics-login")(0).Click
Set ie = Nothing
End Sub
Try the code below:
Option Explicit
Const READYSTATE_COMPLETE As Long = 4
Const URL_String As String = "https://www.prudential.com/login"
Sub Login()
Dim IE As Object
Dim ObjElement As Object
' using Late Binding
Set IE = CreateObject("InternetExplorer.Application")
With IE
.navigate URL_String
.Visible = True
End With
Do While (IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE)
DoEvents
Loop
IE.document.getElementByid("username").Value = "abcdef"
IE.document.getElementByid("password").Value = "12345678"
' Optional: I didn't need the wait time
Application.Wait (Now + TimeValue("0:00:01"))
Set ObjElement = IE.document.getElementsByClassName("btn btn-primary btn-login btn-sm-block analytics-login")
ObjElement(0).Click
Set IE = Nothing
End Sub
Another approach might be something like the following.
Sub Get_Logged_In()
Dim IE As New InternetExplorer, HTML As HTMLDocument
Dim post As Object, elem As Object
With IE
.Visible = True
.navigate "https://www.prudential.com/login"
While .Busy = True Or .readyState < 4: DoEvents: Wend
Set HTML = .document
End With
With HTML
Set post = .querySelector("#username")
post.Focus
post.innerText = "abcdef"
Set elem = .querySelector("#password")
elem.Focus
elem.innerText = "12345678"
.querySelector("button[data-qa='Login Button']").Click
End With
IE.Quit
End Sub
Reference to add to the library:
1. Microsoft Internet Controls
2. Microsoft HTML Object Library
In case anyone else has a similar problem I was finally able to get Sendkeys to work. Still, if anyone can come up with a non-Sendkeys solution it would be much preferred.
Two important points in getting Sendkeys to work are 1) use of
Set WSS = CreateObject("WScript.Shell")
and 2) to be sure to run the macro from Excel (e.g. tools-macro-macros) and not from the VB Editor (running from the editor will simply insert the text somewhere within the code and not on the target webpage).
' Open IE and navigate to the log-in page
Application.StatusBar = "Opening IE and logging in to the website"
Set WSS = CreateObject("WScript.Shell")
my_username = "abcdef"
my_pw = "12345678"
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.navigate "https://www.prudential.com/login"
.Top = 0
.Left = 0
.Height = 1025
.Width = 1925
' Loop until the page is fully loaded
Do Until Not ie.Busy And ie.ReadyState = 4
DoEvents
Loop
Application.Wait (Now + TimeValue("0:00:10"))
WSS.SendKeys "{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}"
Application.Wait (Now + TimeValue("0:00:01"))
WSS.SendKeys my_username
Application.Wait (Now + TimeValue("0:00:01"))
WSS.SendKeys "{TAB}"
Application.Wait (Now + TimeValue("0:00:01"))
WSS.SendKeys my_pw
Application.Wait (Now + TimeValue("0:00:01")
ie.document.getElementsByClassName("btn btn-primary btn-login btn-sm-block analytics-login")(0).Click
' Loop until the page is fully loaded
Do Until Not ie.Busy And ie.ReadyState = 4
DoEvents
Loop
End With
' You're now logged in, do your stuff..

Automatically open a downloaded file Excel VBA

I have some code that goes to a website and logs in. Then, it presses an "Export to Excel" button and gets the save as dialog box. Is there any way that I can press "Open" and get the file open? If you need any HTML code from the website, let me know, because this information is confidential. Thanks in advance!!
Sub Download()
Set IE = New SHDocVw.InternetExplorer
IE.Visible = True
IE.navigate "http://broomfield.flatironslibrary.org/"
While IE.Busy
DoEvents
Wend
Do Until Not IE.Busy And IE.readyState = 4
DoEvents
Loop
IE.document.getElementsByClassName("hidden-xs header-button header-primary")(0).Click
Application.Wait (Now + #12:00:02 AM#)
IE.document.getElementById("username").Value = "user"
IE.document.getElementById("password").Value = "pass"
IE.document.getElementsByClassName("btn btn-primary extraModalButton") (0).Click
Application.Wait (Now + #12:00:02 AM#)
IE.navigate ("http://broomfield.flatironslibrary.org/MyAccount/CheckedOut?exportToExcel")
'This is where the dialog box appears
End sub

Copy and Paste contents from another workbook into current workbook

I have some code that downloads an excel file from the web. I need it to copy and paste its contents into my current workbook, but I get the "Subscript out of range" error. Code is below, and thanks in advance!
Sub dwnld()
Set IE = New SHDocVw.InternetExplorer
IE.Visible = True
IE.navigate "http://broomfield.flatironslibrary.org/"
While IE.Busy
DoEvents
Wend
Do Until Not IE.Busy And IE.readyState = 4
DoEvents
Loop
IE.document.getElementsByClassName("hidden-xs header-button header-primary")(0).Click
Application.Wait (Now + #12:00:02 AM#)
IE.document.getElementById("username").Value = "user"
IE.document.getElementById("password").Value = "pass"
IE.document.getElementsByClassName("btn btn-primary extraModalButton")(0).Click
Application.Wait (Now + #12:00:02 AM#)
IE.navigate ("http://broomfield.flatironslibrary.org/MyAccount/CheckedOut?exportToExcel")
Application.Wait (Now + #12:00:02 AM#)
Application.SendKeys ("%o")
Application.Wait (Now + #12:00:05 AM#)
Call CopyingRange
End Sub
Copying Range Code:
Sub CopyingRange()
Workbooks("CheckedOutItems").Sheets("Checked Out").Range("A3:E62").Copy Range("B2")
End Sub
Please try this code below for CopyingRange
Sub CopyingRange()
Workbooks("CheckedOutItems").Sheets("Checked Out").Range("A3:E62").Copy ThisWorkBook.ActiveSheet.Range("B2")
End Sub
Good luck!

Run VBA automation for pulling internetexplorer source data in background

I work in an engine maintenance department and for alot of our big projects (i.e. diesel engine rebuilds) we have to request alot of parts through our inventory intranet site. all of our parts have an assigned identification/catalog number. Unfortunately the site only lets you search for one part at a time. I created this macro to speed up the process and check our inventory for all catalog numbers I enter into the spreadsheet.
I wrote a macro in VBA that would access the site, use the catalog numbers (I have entered in the A-Column of my worksheet) and plug it into the search inventory page. My Macro would then retrieve the part description, manufacturer part number, number available, number on order and return it to my spreadsheet.
In order for this macro to work I pretty much have to leave my computer alone until the whole process is finished (i.e. no opening up any new windows, no minimizing the macro-opened internet explorer...)
I was wondering if there's any way to make it so that I can use my computer while this macro is running through its thing.
Sub ICSsearch()
Range("A2").Select
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
'Go to this Web Page!
IE.navigate "http://dd2.deepwater.com/t-sso-v206/sso/logon.aspx?baseurl=http://dd2.deepwater.com/ics/home.aspx"
'Check for good connection to web page loop!
Do
If IE.readyState = 4 Then
IE.Visible = True
Exit Do
Else
DoEvents
End If
Loop
'Wait for window to open!
Application.Wait (Now + TimeValue("0:00:01"))
IE.Visible = True
'Send logon information
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "ENTER USERNAME", True
SendKeys "{TAB}", True
SendKeys "ENTER PASSWORD", True
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{Enter}", True
'Go to this Web Page for Search Inventory (also start of search loop)!
Do
Application.Wait (Now + TimeValue("0:00:02"))
IE.navigate "http://dd2.deepwater.com/ics/stocksearch.aspx"
'Enter ICN number
Application.Wait (Now + TimeValue("0:00:02"))
IE.Document.getelementbyid("ctl05_TextBoxSCN").Value = Range("A" & (ActiveCell.Row))
Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{Enter}", True
'Extract ICS Results
Application.Wait (Now + TimeValue("0:00:02"))
Range("B" & (ActiveCell.Row)) = IE.Document.getelementbyid("ctl05_LabelPartNumber").innerText
Range("C" & (ActiveCell.Row)) = IE.Document.getelementbyid("ctl05_LabelDescription").innerText
Range("D" & (ActiveCell.Row)) = IE.Document.getelementbyid("ctl05_LabelUsableQty").innerText
Range("E" & (ActiveCell.Row)) = IE.Document.getelementbyid("ctl05_LabelOnOrderQuantity").innerText
Range("A" & (ActiveCell.Row)).Select
ActiveCell.Offset(1, 0).Select
If Range("A" & (ActiveCell.Row)).Value = "" Then
Exit Do
Else
DoEvents
End If
Loop
End Sub
If we using "SendKeys" Method system wont allow you to work.. Instead you can find out your site UserName and PassWord input box ids or Name and the use below code.
IE.Document.getElementByID("YourIDID").value = UserName
IE.Document.getelementByID("YouPWDID").vlaue = PWD
IE.Document.getelementByID("ButtonID").click
By using this way there is no dependency between excel and other applications so you can use your system.
If you use send key there is a possibility it can type anywhere instead of input box.
This is done in IE Window only, you can use your computer?
'
' Do IE wait: waiting for IE query return:
' inputs:
' objIe: IE object
'
Function sofDoIeWait(ByVal objIe)
While (objIe.Busy Or objIe.readyState <> 4)
DoEvents
Wend
sofDoIeWait = 1
End Function
Sub sof20160137ICSsearch()
Dim iRow As Long, IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
'Go to this Web Page!
IE.navigate "http://dd2.deepwater.com/t-sso-v206/sso/logon.aspx?baseurl=http://dd2.deepwater.com/ics/home.aspx"
'Check for good connection to web page loop!
sofDoIeWait IE
'Wait for window to open!
' Application.Wait (Now + TimeValue("0:00:01"))
' IE.Visible = True
'Send logon information
' Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "ENTER USERNAME", True
SendKeys "{TAB}", True
SendKeys "ENTER PASSWORD", True
' Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "{Enter}", True
sofDoIeWait IE
'
' now we are logged in, so go to the search page:
'
IE.navigate "http://dd2.deepwater.com/ics/stocksearch.aspx"
sofDoIeWait IE
'
Range("A2").Select
iRow = ActiveCell.Row
'
'Go to this Web Page for Search Inventory (also start of search loop)!
'
Do
'Application.Wait (Now + TimeValue("0:00:02"))
'Enter ICN number
'Application.Wait (Now + TimeValue("0:00:02"))
'
' do search the value of the ActiveCell:
'
IE.Document.getElementById("ctl05_TextBoxSCN").Value = Range("A" & iRow)
'Application.Wait (Now + TimeValue("0:00:02"))
SendKeys "{Enter}", True
sofDoIeWait IE
'
'Extract ICS Results
'Application.Wait (Now + TimeValue("0:00:02"))
'
Range("B" & iRow) = IE.Document.getElementById("ctl05_LabelPartNumber").innerText
Range("C" & iRow) = IE.Document.getElementById("ctl05_LabelDescription").innerText
Range("D" & iRow) = IE.Document.getElementById("ctl05_LabelUsableQty").innerText
Range("E" & iRow) = IE.Document.getElementById("ctl05_LabelOnOrderQuantity").innerText
Range("A" & iRow).Select
ActiveCell.Offset(1, 0).Select
iRow = ActiveCell.Row
If Range("A" & iRow).Value = "" Then
Exit Do
Else
DoEvents
End If
Loop
End Sub