I'am new to vba in excel. I managed to write a code which scrapes data from a given website and stores it in an excel worksheet. The code works almost every time i run it but sometimes i get an error:
Object variable or With block variable not set.
So it is very challenging to find out why. Also if you could help me out speeding the code (maybe not using clipboard to pastspecial the table, but I don't know how to use otherwise...). Also for you to know, once the error is promted if I click end and run the sub again, it runs without any problem. The error is promted (sometimes only, most of the time the sub works fine) in the specified line with this comment: 'This is the line which throws the error. I appreciate any kind of help guys, thank you in advance :).
The sub looks like this:
Sub PaData()
Dim c As Object, D As Object, H As Object, PID$, SD As Date, FC$, cf$
Set c = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Set D = CreateObject("HTMLFile")
Set H = CreateObject("WinHTTP.WinHTTPRequest.5.1")
FC = "EXA" ' This is used to generate the website url
cf = VBMa ' This is another sub which works fine and i need it to get into the webiste
' Get the page
H.SetAutoLogonPolicy 0
H.SetClientCertificate "CURRENT_USER\MY\" & Environ("USERNAME")
H.Open "GET", "https://confidentialwebsite=" & FC
H.setRequestHeader "Cookie", cf
H.Send
H.waitForResponse
' Put the response into the HTML object
D.body.innerHTML = H.ResponseText
' Copy _only a given Table
c.setText D.getElementByID("giventable").outerHTML 'This is the line which throws the error
c.PutInClipBoard
' Paste into the sheet, remove hyperlinks and unMerge all data
Sheets("Pdata").Cells.Delete
Sheets("Pdata").[A1].PasteSpecial
Sheets("Pdata").Cells.Hyperlinks.Delete
Sheets("Pdata").Cells.UnMerge
'update time
Sheets("SM").Range("B1").Value = Sheets("Pdata").Range("D2").Value + 2 / 24
End Sub
When doing an HTTPRequest to a webserver, you should always verify the return status of this call using .Status (see: this )
An overview of the possible status numbers can be found here: https://httpstatuses.com/ or here: https://en.wikipedia.org/wiki/List_of_HTTP_status_codes#1xx_Informational_response
Related
I have a list of Twitter urls in Column A, for which I am trying to pull some information off, however I am having a lot of trouble. I want to pull off everything in yellow
I am not sure if it is due to having the wrong classes or due to the Twitter Urls NOT opening in excel. If I double click a url in excel and try to open it I get this error message.
The link works fine when I copy and paste them into the browser. I have read some information on the web that states that a HKEY on the PC may need changing LINK. The problem I have the person I am building this for is not pc literate and will struggle, to do any fix.
I have always used the below code for scraping and it has never failed me. When it does pull data off Twitter, I get an error message, see image below columns D + E. I am assuming this is making some contact to Twitter but can not access the page to extract the data. I am NOT using IE as it no longer works with twitter, I am using a MSXML2.ServerXMLHTTP.
This is what i am using to extract the data, it is the same for all the columns, just the class changes and if it is a Span or a child.
''''Element 3 Column D
If doc.getElementsByClassName("css-1dbjc4n")(0) Is Nothing Then
wsSheet.Cells(StartRow + myCounter, 4).Value = "-"
Else
wsSheet.Cells(StartRow + myCounter, 4).Value = doc.getElementsByClassName("css-1dbjc4n")(0).getElementsByTagName("Span")(0).innerText
End If
Public Function NewHTMLDocument(strURL As String) As Object
Dim objHTTP As Object, objHTML As Object, strTemp As String
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objHTTP.setOption(2) = 13056
objHTTP.Open "GET", strURL, False
objHTTP.send
If objHTTP.Status = 200 Then
strTemp = objHTTP.responseText
Set objHTML = CreateObject("htmlfile")
objHTML.body.innerHTML = strTemp
Set NewHTMLDocument = objHTML
Else
'There has been an error
End If
End Function
QUESTION
Is the problem due to the urls not opening in excel, or is it because the data is dynamic and it can not be extracted?
Twitter Link 1
Twitter Link 2
As always thanks for having a look and my apologies in advance for NOT adding HTML snippet as it would not let me post, I could not find the error so removed the html, it was stating that a URL had been shortened, but could not find it so removed the whole html snippet in order to post.
UPDATE
I thought this link was in my post, but I must have removed it when I removed the HTML Snippet. I found this on Stackoverflow but could not get it to work form me, nothing would extract Link
I am trying to create a VBA to download a google sheet into excel so I can compile stock market data daily. I would simply use power query for this but I am doing this on my personal laptop which is a mac and does not support power query. I am relatively new to coding so have been leaning on following online instructions. The instruction includes this:
Set objWebCon = CreateObject("MSXML2.XMLHTTP.3.0")
This line when ran creates an error message saying:
"
Run-time error '429':
ActiveX component can't create object
"
I think the issue lies within the fact that the instruction is based on a windows operating system. Any solution I've searched for is specific to windows operating systems.
Does anybody here know if I can change the "MSXML2.XMLHTTP.3.0" part of my code to fit it better to mac? Not sure if this is what needs to be done but any guidance would be super appreciated.
I attached my full code below but feel free to ignore it if not relavent. Thank you!!
Sub DownloadGoogleSheets()
Dim ShtUrl As String, Location As String, FileName As String
Dim objWebCon, objWrit As Object
'Sheet Url
ShtUrl = "https://docs.google.com/spreadsheets/d/1wpA_epxtlz96sxETqKttJwsy9Aubb15H8xslcSQ20T0/export?format=csv&id=1wpA_epxtlz96sxETqKttJwsy9Aubb15H8xslcSQ20T0" & gid = 1319327791
'Location
Location = ThisWorkbook.Path & "\" '/Users/[myName]/Desktop/Stock Analysis/n"
'FileName
FileName = "GoogleSheet.csv"
'Connection to Website
Set objWebCon = CreateObject("MSXML2.XMLHTTP.3.0")
'Writer
Set objWrit = CreateObject("ADODB.Stream")
'Connecting to the Website
objWebCon.Open "Get", ShtUrl, False
objWebCon.Send (ShtUrl)
'Once page is fully loaded
If objWebCon.Status = 200 Then
'Write the text of the sheet
objWrit.Open
objWrit.Type = 1
objWrit.Write objWebCon.ResponseBody
objWrit.Position = 0
objWrit.SaveToFile Location & FileName
objWrit.Close
End If
Set objWebCon = Nothing
Set objWrit = Nothing
End Sub
Hi StackOverflow community!
Before I go to the nearest petrol station to buy a gallon of petrol and then proceed to a shopping centre (wiping tears of desperation along the way) to set my self on fire...
I am trying to parse few websites, each an instance of finance.google.co.uk, for share prices. This sub only opens 3 sites(for now, I'm planning few hundred), get the share price from each and puts it in cells A1, A2, A3 respectively. The code I wrote works fine only after starting/ restarting my laptop and running excel the first time. 2nd and subsequent runs produce random results, meaning 2nd run will give me say A1 and A3 values, next A1, next A1 and A2 etc. Have spent last few days trying to figure out what is going on. Also I cant find a way to get rid of the "On Error Resume Next" line. If I do that I get "Method 'Navigate' of Object 'IWebBrowser2' failed" error, any idea why?. BTW, I'm green, code for personal use, or trying to. So maybe I overlooked something painfully simple, or what I think is the case, simply don't know that simple thing.
The gear:
- windows7 32bit
- IE 11
My sub:
Sub Google_Finance()
Dim o(3) As String
o(1) = "http://finance.google.co.uk/finance?q=LON%3ABARC"
o(2) = "http://finance.google.co.uk/finance?q=LON%3ACCH"
o(3) = "http://finance.google.co.uk/finance?q=LON%3ASUK2"
Dim IE As Object
Set IE = New InternetExplorer
IE.Visible = False
For i = 1 To 3
IE.navigate o(i)
On Error Resume Next
Do While IE.Busy
DoEvents
Loop
Next i
Dim n as Integer
n = 1
Dim v(3) As Variant
v(1) = IE.document.getElementById("ref_11248216_l").innerText"
v(2) = IE.document.getElementById("ref_243113080920948_l").innerText
v(3) = IE.document.getElementById("ref_14572000_l").innerText
For i = 1 To 3
Sheet1.Range("a" & n) = v(i)
n = n + 1
Next i
IE.Quit
Set IE = Nothing
End Sub
Cheers,
Sam
I tried running the code on my side. I don't get the error you are getting when removing 'on error'. Code works OK for me few times in a row, no issues occurred.
To me it looks like this: the error you are getting is happening when IE is trying to reach the page. Because you use 'on error resume next', the compiler does not try to rerun this task on failure, thus any error leads to no data for the value it is trying to read from the web.
You should either: a) remove 'on error resume next' or b) change error handling to loop the task until completion.
For solution a) you will need to overcome your error, which I believe is explained here
For solution b) you will need to change your sub to include a loop - example solution can be found here
Hope this helps!
I am a self-taught, amateur programmer, and I am new to this forum. Please bear with me.
About two years ago, I wrote a simple Excel vba program to login in to a website and grab a customer statement in the form of a .csv file. My program utilizes GET and POST requests. This program worked perfectly (for my needs) until about three weeks ago, when it unfortunately broke on me. The program could not get through the initial GET request. Specifically, it would break on the getReq.send line.
I came across this post:
Login into website using MSXML2.XMLHTTP instead of InternetExplorer.Application with VBA
Here, I learned that you can use "Msxml2.XMLHTTP.6.0" instead of "Msxml2.ServerXMLHTTP.6.0". I modified my code accordingly, eliminating the need to parse cookies after the Get request, and it worked! But I have no idea. Even though I got it to work, I do not feel like I have learned much in the process.
Some information to note:
My original program broke on my work computer (WindowsXP).
Figuring that it may be an XP issue, and in the market for a new machine anyway, I updated to a new computer running Windows7. The program still did not work, though I received a different error message.
I ran my code on a Windows10 computer and it worked fine.
I use identical code to connect to various other websites and it works fine, regardless of what operating system.
So, my specific questions:
Why might the code work with Msxml2.XMLHTTP.6.0 but not Msxml2.ServerXMLHTTP.6.0?
And why might the code have broken in the first place?
Why would the code work on one particular website, but no another?
Any insight would be greatly appreciated. I have attached my code (with login info X'd out).
Sub RCGInquiry()
Dim postReq, getReq, cookies
Dim p0 As Integer, p1 As Integer, temp As String
Dim result As String, respHead As String
Set getReq = CreateObject("Msxml2.ServerXMLHTTP.6.0")
'Set getReq = CreateObject("Msxml2.XMLHTTP.6.0")
' Visit homepage so we can find the cookies
getReq.Open "GET", "https://www.rcginquiry.com/sfs/Entry", False
getReq.send
respHead = getReq.getAllResponseHeaders
Debug.Print respHead
' Need to parse the cookie from Respone Headers
cookies = ""
p0 = 1
Do While InStr(p0, respHead, "Set-Cookie:") > 0
p0 = InStr(p0, respHead, "Set-Cookie:") + 11
p1 = InStr(p0, respHead, Chr(10))
temp = Trim(Mid(respHead, p0, p1 - p0))
cookies = cookies & temp & "; "
Loop
cookies = Left(cookies, Len(cookies) - 2)
' Debug.Print cookies
' Login
Set postReq = CreateObject("Msxml2.ServerXMLHTTP.6.0")
'Set postReq = CreateObject("Msxml2.XMLHTTP.6.0")
postReq.Open "POST", "https://www.rcginquiry.com/sfs/Entry", False
postReq.setRequestHeader "Cookie", cookies
postReq.setRequestHeader "Content-type", "application/x-www-form-urlencoded" 'send appropriate Headers
postReq.send "Usrid=XXXX&Psswd=XXXX" ' send login info
'-------------------------------------------------------------------------------
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FSO As Object
Dim myFile As Object
Dim path As String
Dim y As Integer
curDate = Format(Date, "mm_dd_yy")
' Download CSV
postReq.Open "POST", "https://www.rcginquiry.com/sfs/Downloads/tmp.csv?filetype=POS&format=MFA20&heading=true&allaccts=true&junk=tmp.csv", False
postReq.setRequestHeader "Cookie", cookies 'must resend cookies so it knows i am logged in
postReq.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
postReq.send "filetype=POS&format=MFA20&heading=true&allaccts=true&junk=temp.csv" 'url query parameters
' Writes responseText to a .csv file
Set FSO = CreateObject("Scripting.FileSystemObject")
Set myFile = FSO.createtextfile("C:\Users\Adam\Desktop\POSITION\" & curDate & ".csv", True)
myFile.write (postReq.responseText)
myFile.Close
Set FSO = Nothing
Set myFile = Nothing
End Sub
This blog post says that ServerXLMHTTP will not work through a proxy on the client, but XMLHTTP will. In Excel VBA I was using ServerXLMHTTP.6.0, and it was failing for some clients inside corporate networks, whereas XMLHTTP worked.
Welcome to VBA and StackOverflow. Your notes are thorough and so the only thing I can suggest is that you check your proxy settings.
https://support.microsoft.com/en-us/help/289481/you-may-need-to-run-the-proxycfg-tool-for-serverxmlhttp-to-work
That link was buried in this link
https://support.microsoft.com/en-us/help/290761/frequently-asked-questions-about-serverxmlhttp
which you were referred to by ComIntern
I've spent a bunch of time trying to figure out how to get this done but to no avail.
We populate a new word doc based on a template using data from Excel. Excel VBA script gets the data and pastes it into the Word doc at the indicated bookmarks. This works great.
However, when I try to align a column that already exists in the table, it throws an error. I've tried other variants but am just shooting in the dark.
The code compiles without error.
' This code runs fine
ActiveDocument.Tables(1).AutoFitBehavior wdAutoFitWindow
ActiveDocument.Tables(1).PreferredWidthType = wdPreferredWidthPercent
ActiveDocument.Tables(1).PreferredWidth = 100
ActiveDocument.Tables(1).Columns(2).Select
' I get an error "438 - Object Doesn't support this property or method"
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Any thoughts are appreciated.
Doug
Try something like this:
Dim c As Cell, t as Table
Set t = ActiveDocument.Tables(1)
With t.Columns(2)
For Each c In .Cells
c.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
Next c
End With