I am trying to write code to upload data into web form at work. If I copy and paste the details the form accepts the values, but If the VBA code enters the same exact values then I get input error.
Screen script of form is below
This Excel Vba code taken from StackOverflow searches and youtube "https://www.youtube.com/watch?v=T6HRjiAdW38&list=PLBGMKJfLuhqa3q0RWyiN40NV24rxTJ0Yt&index=1"
Sub Ihub_upload()
Dim appIE As InternetExplorerMedium
Dim objElement As Object
Dim objCollection As Object
Dim sURL As String
Set appIE = New InternetExplorerMedium
sURL = "company web site "
With appIE
.navigate sURL
.Visible = True
End With
Do While appIE.Busy
Application.Wait DateAdd("s", 2, Now)
Loop
':::: Enter data collection ::::'
' I will put code below into a loop to enter multiple values if it works'
'Data collecton'
appIE.document.getElementById("CPH_MasterBody_CPH_EtlMasterBody_DDL_DataCollection").Value = 120
'File location tab 16'
appIE.document.getElementById("CPH_MasterBody_CPH_EtlMasterBody_TXT_SourceConnectionString").Value = "Y:\Databases\2019-Kv9xQ.xls"
'start date tab 18 '
appIE.document.getElementById("CPH_MasterBody_CPH_EtlMasterBody_TXT_PeriodStartDateTime").Value = "01/09/2019"
'End date tab 19'
appIE.document.getElementById("CPH_MasterBody_CPH_EtlMasterBody_TXT_PeriodEndDateTime").Value = "30/09/2019"
'publication date tab 20 '
If ThisWorkbook.Sheets("Data").Range("I3").Value <> "" Then
appIE.document.getElementById("CPH_MasterBody_CPH_EtlMasterBody_TXT_PublicationDateTime").Value = "14/11/2019"
End If
'Source URL tab 21 '
If ThisWorkbook.Sheets("Data").Range("I3").Value <> "" Then
appIE.document.getElementById("CPH_MasterBody_CPH_EtlMasterBody_TXT_SourceUrl").Value = "https://www.england.nhs.uk"
End If
':::: Save record? click ok button ::::'
Application.Wait DateAdd("s", 3, Now)
appIE.document.getElementById("CPH_MasterBody_CPH_EtlMasterBody_BTN_Save").Click
Related
I am trying to scrape some data from a dictionary with a condition and print the result data to my excel document.
The Website: https://tureng.com/tr/turkce-ingilizce
Excel Document Sample
The code needs to take the data from column (A) and print it to the searchbar on the website. Then it needs to click enter and take the translated data whose type matches the column (E) which is in my document. For example: adjective means "s." on the website. So the code should take the first word that has "s." for the example word "all right"
As a result of my tryings, I came to this stage, but I do not know how to pull data of class type depending on the condition. Can you guys please help me?
Const URLstr As String = "https://tureng.com/tr/turkce-ingilizce/seal"
Private Sub CommandButton1_Click()
Dim objIE As SHDocVw.InternetExplorer
Dim ieDoc As MSHTML.HTMLDocument
Dim searchfield As MSHTML.HTMLInputElement
Dim searchbutton As MSHTML.HTMLInputElement
Dim result As MSHTML.HTMLInputElement
Dim i As Integer
Set objIE = New SHDocVw.InternetExplorer
objIE.Navigate URLstr
Do Until objIE.readyState = READYSTATE_COMPLETE: Loop
Set ieDoc = objIE.document
objIE.Visible = True
For i = 2 To 94
Set searchfield = ieDoc.all.Item("searchTerm")
Application.Wait Now() + #12:00:01 AM#
searchfield.Value = Cells(i, 1)
searchfield.Select
Application.SendKeys "~"
Application.Wait Now() + #12:00:01 AM#
Set result = ieDoc.all.Item("tr ts")(0)
Cells(i, 2) = result.innerText
Next i
objIE.Quit
End Sub
html code of the website
I have written a VBA to scrape the status of a shipment from a cargo tracking site with the help of you guys here. I am trying to convert it to a function. The code works as a sub but does not work as a function. It returns a #Value error. Can someone please tell me what I am doing wrong.
Here is the code as a sub
Sub FlightStat_AFL()
Dim url As String
Dim ie As Object
Dim MAWBStatus As String
Dim MAWBNo As String
MAWBNo = Sheets("Sheet3").Range("H3").Value
'You can handle the parameters id and pfx in a loop to scrape dynamic numbers
url = "https://www.afklcargo.com/mycargo/shipment/detail/057-" & MAWBNo
'Initialize Internet Explorer, set visibility,
'call URL and wait until page is fully loaded
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
ie.navigate url
Do Until ie.readyState = 4: DoEvents: Loop
'Wait to load dynamic content after IE reports it's ready
'We do that with a fix manual break of a few seconds
'because the whole page will be "reload"
'The last three values are hours, minutes, seconds
Application.Wait (Now + TimeSerial(0, 0, 3))
'Get the status from the table
MAWBStatus = ie.document.getElementsByClassName("fs-12 body-font-bold")(1).innertext
Debug.Print MAWBStatus
'Clean up
ie.Quit
Set ie = Nothing
End Sub
Here is the code I am trying to make it work as a function.
Function FlightStat_AF(MAWBNo As Range) As String
Dim url As String
Dim ie As Object
Dim MAWBStatus As String
url = "https://www.afklcargo.com/mycargo/shipment/detail/057-" & MAWBNo
'Initialize Internet Explorer, set visibility,
'call URL and wait until page is fully loaded
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
ie.navigate url
Do Until ie.readyState = 4: DoEvents: Loop
'Wait to load dynamic content after IE reports it's ready
'We do that with a fix manual break of a few seconds
'because the whole page will be "reload"
'The last three values are hours, minutes, seconds
Application.Wait (Now + TimeSerial(0, 0, 3))
'Get the status from the table
MAWBStatus = ie.document.getElementsByClassName("fs-12 body-font-bold")(1).innertext
FlightStat_AF = MAWBStatus
'Clean up
ie.Quit
Set ie = Nothing
End Function
Try the next code, please:
Function FlightStat_AF(cargoNo As Variant) As String
Dim url As String, ie As Object, result As String
url = "https://www.afklcargo.com/mycargo/shipment/detail/" & cargoNo
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = False
.navigate url
Do Until .readyState = 4: DoEvents: Loop
End With
'wait a little for dynamic content to be loaded
Application.Wait (Now + TimeSerial(0, 0, 1))
'Get the status from the table
Do While result = ""
DoEvents
On Error Resume Next
result = Trim(ie.document.getElementsByClassName("fs-12 body-font-bold")(1).innerText)
On Error GoTo 0
Application.Wait (Now + TimeSerial(0, 0, 1))
Loop
ie.Quit: Set ie = Nothing
'Return value of the function
FlightStat_AF = result
End Function
IE Function
You can try this if you really want a range. Usually it should be a string which you can easily change.
You can test the function (2nd procedure) with the first procedure. Just adjust the values in the constants section.
The Code
Option Explicit
Sub getFlightStat()
' Constants
Const wsName As String = "Sheet3"
Const FirstRow As Long = 3
Const CritCol As Variant = "H"
Const ResCol As Variant = "I"
Dim wb As Workbook: Set wb = ThisWorkbook
' Define worksheet.
Dim ws As Worksheet
Set ws = wb.Worksheets(wsName)
' Calculate the row of the last non-blank cell in column 'CritCol'.
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, CritCol).End(xlUp).Row
' Loop through rows and for each value in cell of column 'CritCol',
' write the value retrieved via 'FlightStat_AF' to the cell
' in the same row, but in column 'ResCol'.
Dim i As Long
For i = FirstRow To LastRow
ws.Cells(i, ResCol).Value = FlightStat_AF(ws.Cells(i, CritCol))
Next i
' Inform user.
MsgBox "Data transferred", vbInformation, "Success"
End Sub
Function FlightStat_AF(MAWBNo As Range) As String
Dim url As String
Dim ie As Object
Dim MAWBStatus As String
'You can handle the parameters id and pfx in a loop to scrape dynamic numbers
url = "https://www.afklcargo.com/mycargo/shipment/detail/057-" & MAWBNo.Value
'Initialize Internet Explorer, set visibility,
'call URL and wait until page is fully loaded
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
ie.navigate url
Do Until ie.readyState = 4: DoEvents: Loop
'Wait to load dynamic content after IE reports it's ready
'We do that with a fix manual break of a few seconds
'because the whole page will be "reload"
'The last three values are hours, minutes, seconds
Application.Wait (Now + TimeSerial(0, 0, 3))
'Get the status from the table
MAWBStatus = ie.document.getElementsByClassName("fs-12 body-font-bold")(1).innertext
FlightStat_AF = MAWBStatus
'Clean up
ie.Quit
Set ie = Nothing
End Function
I am running VBA in excel in order to do some web-scraping, but am coming up with this error when attempting to reach Google Chrome. How would one avoid this? I will click debug then a single line becomes highlighted...
This is where the error pops up
This is the highlighted line of code that must be giving the issue
Full Code in this picture
FULL CODE BELOW:
Private Sub time_sheet_filling()
Dim I As Long
Dim IE As Object
Dim doc As Object
Dim objElement As Object
Dim objCollection As Object
' Create InternetExplorer Object
Set IE = CreateObject("ChromeTab.ChromeFrame")
IE.Visible = True
' Send the form data To URL As POST binary request
IE.navigate "https://wistar.dispondo.net/#/login"
' Wait while IE loading...
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
'Load the logon page
Set objCollection = IE.Document.getElementsByTagName("input")
I = 0
While I < objCollection.Length
If objCollection(I).Name = "username" Then
' Set text to enter
objCollection(I).Value = "MyUsername"
End If
If objCollection(I).Name = "password" Then
' Set text for password
objCollection(I).Value = "MyPasword"
End If
If objCollection(I).Type = "submit" And objCollection(I).Name = "btnSubmit" Then ' submit button clicking
Set objElement = objCollection(I)
End If
I = I + 1
Wend
objElement.Click ' click button to load the form
' Wait while IE re-loading...
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
' Show IE
IE.Visible = True
Dim links, link
Dim n, j
Set links = IE.Document.getElementById("dgTime").getElementsByTagName("a")
n = links.Length
For j = 0 To n - 1 Step 2
links(j).Click
'I have some operations to be done will post another question for this
Next
End Sub
That error would occur if there is not a worksheet named "Website Data" in the active workbook at the time of the code running. Either the worksheet name does not match, or a different workbook is active when the code is running.
Make sure the worksheet name is correct and also explicitly reference the workbook it is located in (so that it doesn't matter which workbook is active when the code is running). If the "Website Data" sheet is in the workbook where the code is running, then refer to the value in the cell using:
ThisWorkbook.Sheets("Website Data").Cells(1,1).Value
You can't use Chrome instead of IE in this way. Chrome can only use via Selenium for web scraping via VBA. The IE is the only browser with a COM Interface which is needed to control an application via VBA:
For more information:
About the Component Object Model (COM)
About Selenium browser automation
What I have to do is use Excel VBA to:
login to Amazon Seller
open a workbook
loop through a column to get an order number
put it in the search box
hit the search button
go to the order page and extract the data
then have the extracted data go back into a specified column in
another Excel workbook
The loop and order number parts are what I'm currently stumped on. I've figured out this much code as of this moment:
Sub MyAmazonSeller()
Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
Dim oSignInLink As HTMLLinkElement
Dim oInputEmail As HTMLInputElement
Dim oInputPassword As HTMLInputElement
Dim oInputSigninButton As HTMLInputButtonElement
'InputSearchOrder will be the destination for order numbers taken from the workbook
Dim InputSearchOrder As HTMLInputElement
Dim InputSearchButton As HTMLInputButtonElement
Dim IE As InternetExplorer
Dim AAOrder As Workbook
Dim AAws As Worksheet
MyURL = "https://sellercentral.amazon.com/gp/homepage.html"
Set IE = New InternetExplorer
' Open the browser and navigate.
With IE
.Silent = True
.Navigate MyURL
.Visible = True
Do
DoEvents
Loop Until .ReadyState = READYSTATE_COMPLETE
End With
' Get the html document.
Set HTMLDoc = IE.Document
' See if you have the sign in link is because you are in the main
' page
Set oSignInLink = HTMLDoc.getElementById("signin-button-container")
If Not oSignInLink Is Nothing Then
oSignInLink.Click
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
End If
' Get the email field and the next button
Set oInputEmail = HTMLDoc.getElementById("username")
Set oInputPassword = HTMLDoc.getElementById("password")
' Click the button and wait
oInputEmail.Value = "xxxxxx#xxxxxx.net"
' Get the password field and the sign in button
Set oInputPassword = HTMLDoc.getElementById("password")
Set oInputSigninButton = HTMLDoc.getElementById("sign-in-button")
' Click the button and wait
oInputPassword.Value = "xxxxxxxx"
oInputSigninButton.Click
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
Application.Wait (Now + TimeValue("0:00:05"))
Set AAOrder = Application.Workbooks.Open("Z:\Employee Folders\Employee\trackingnumber_sample_spreadsheet.xls")
Set AAws = AAws.Worksheets("PrimeOrdersWithNoFulfillmentRe")
Set InputSearchOrder = HTMLDoc.getElementById("sc-search-field")
'What I'm currently stuck on
InputSearchOrder.Value = "001-7163923-7572632"
Set InputSearchButton = HTMLDoc.getElementsByClassName("sc-search-button")(0)
InputSearchButton.Click
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
'Was able to add this snippet, but I'm getting an error 13, most likely with
'my e variable. I'm basically trying to do a loop within a loop, extracting 5
'pieces of data and sticking them back into their respective columns in the
'original Excel sheet. The problem comes when scraping the HTML. I'm basically
'trying to get text in the tables which have a few levels and it's frustrating
'me to no end.
With HTMLDoc
Set elems = HTMLDoc.getElementsByTagName("td")
For Each e In elems
If e.innerText Like "*1Z*" Then
Range("D2").Value = e.innerText
End If
Next e
End With
Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub
There is a website I routinely use to generate a spreadsheet. The only items on the website are a "Start Date" field, an "End Date" field, and a "Go" button. After I enter my date range and click "Go" it downloads a .cfm file, I click open with excel, excel warns the file has a different extension and verifies it's not corrupted and I click open and I have the data I need and from there have a macro to maniupulate as needed.
I'm looking to automate the steps:
Go to website
Change Start Date
Change End Date
Click Go
Click Open file
Agree to open different extension
The macro I've used before to get data from a website only copies and pastes data visible on a specific url and is as follows. I manipulate the url on my Input spreadsheet to manipulate the data.
Dim addWS As Worksheet
Set addWS = Sheets.Add(Before:=Sheets("Input"))
addWS.Name = "Website Data"
Dim myurl As String
myurl = Worksheets("Input").Range("G4")
With Worksheets("Website Data").QueryTables.Add(Connection:= _
"URL;" & myurl, _
Destination:=Range("A3"))
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Thank you.
The following code works for me. You will have to change "startDate" and "endDate" depending on how the specific website names the input boxes.
Sub test_fetch()
Dim IE As Object
Dim objElement As Object
Dim objCollection As Object
Dim i As Long
Dim Doc As Object, lastrow As Long, tblTR As Object
Set IE = CreateObject("InternetExplorer.application")
IE.Visible = True
IE.navigate "http://your_website"
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
Application.StatusBar = "Fetching Website Data. Please wait..."
Set objCollection = IE.document.getElementsByTagName("input")
i = 0
While i < objCollection.Length
If objCollection(i).Name = "startDate" Then
' Set text for start date
objCollection(i).Value = "09/15/2013"
ElseIf objCollection(i).Name = "endDate" Then
' Set text for end date
objCollection(i).Value = "09/21/2013"
Else
If objCollection(i).Type = "submit" And _
objCollection(i).Name = "" Then
' "Search" button is found
Set objElement = objCollection(i)
End If
End If
i = i + 1
Wend
objElement.Click ' click button to search
End Sub