Run-time error '--1072896658 (c00ce56e)': System does not support the specified encoding
I'm trying to pull pricing data from this website: http://web.tmxmoney.com/pricehistory.php?qm_symbol=^TTUT. I keep getting the error "Run-time error '--1072896658 (c00ce56e)': System does not support the specified encoding".
I've used the code provided below to pull HTML data from most websites. This one is the only one which gives me this error. I think it is possible that i'm getting the error because the website uses Javascript, but i'm not sure. It definitely has something to do with the "tags" layout of the webpage. I can pull using the code from the first tag titled "Quote" (http://web.tmxmoney.com/quote.php?qm_symbol=^TTUT) but not the other tabs.
Option Explicit
Sub TEST_PULL()
Dim Look_String As String
Dim Web_HTML As String
Dim HTTP_OBJ As New MSXML2.XMLHTTP60
Dim xa As Long
Dim xb As Long
Select Case HTTP_OBJ.Status
Case 0: Web_HTML = HTTP_OBJ.responseText
Case 200: Web_HTML = HTTP_OBJ.responseText **'THE ERROR IS CAUSED HERE**
Case Else: GoTo ERROR_LABEL:
End Select
Look_String = "quote-tabs-content"
xa = IIf(IsNumeric(Look_String), Look_String, InStr(Web_HTML, Look_String))
xb = IIf(xa + 32767 <= Len(Web_HTML), 32767, Len(Web_HTML) - xa + 1)
Web_HTML = Mid(Web_HTML, xa, xb)
ERROR_LABEL:
End Sub
Can someone please help me figure out
Why this is happening
How I can successfully pull that pricing data
It would be a huge help!!! Thanks!!!
It's not you, it's them.
The response headers for the page which is causing the error specify an encoding which doesn't exist: ISO-8559-1. ISO 8559 has nothing to do with text encoding - it actually relates to the sizing of clothes. This should almost certainly be ISO-8859-1 instead.
The quote page which is successfully being read has the correct ISO-8859-1 encoding.
To get around this issue, use the responseBody property which contains the raw bytes before decoding. The StrConv function can then attempt to convert those bytes into a Unicode string (although this might not produce correct results in all cases), like this:
Case 200: Web_HTML = StrConv(HTTP_OBJ.responseBody, vbUnicode)
Related
I'm trying to communicate with Google Distance API via VBA in 64bit Excel 365, but having trouble with special character input in street address data. Other threads having similar issues with other HTTP requests, though with output and I struggle to relate.
Sub Check_routes()
Dim objRequest, Json As Object
Dim apiKey, apiURL, myOrigin, myDest As String
Set objRequest = CreateObject("MSXML2.XMLHTTP")
myOrigin = "Tähetorni+1+Tallinn"
myDest = "Sääse+2+Tallinn"
apiURL = "https://maps.googleapis.com/maps/api/distancematrix/json?units=metric&origins=" & myOrigin & "&destinations=" & myDest & "&mode=driving&key=" & apiKey
objRequest.Open "GET", apiURL, False
objRequest.send
...
Set objRequest = Nothing
End Sub
I'm getting an error response in JSON back stating Invalid 'origins' parameter. The problem is special character ä in origin & destination. Replacing this with a fixes it, but that's not a reliable solution. Is my problem string not being UTF-8 as Google stipulates?
https://developers.google.com/maps/documentation/distance-matrix/web-service-best-practices#BuildingURLs
Power Query in Excel environment is also perfectly capable in communicating with Google Distance API and has no problem handling special characters - and is a more convenient tool on top of that, however annoyingly generates duplicate requests which is less than ideal with a paid API such as Google Distance. That's the lone reason for going with VBA here.
Is this a MSXML2.XMLHTTP object problem which cannot handle my input string as is?
I suggest you change these two lines in your code:
myOrigin = WorksheetFunction.EncodeURL("Tähetorni 1 Tallinn")
myDest = WorksheetFunction.EncodeURL("Sääse 2 Tallinn")
Your code returns a valid string with those changes (also note I replaced the + with <space> as the function will take care of encoding that also).
By the way, you need to specify data type for each element in a declaration string. They will NOT take the data type of the last element. Rather they will be of type Variant when not specified.
So change these lines also:
Dim objRequest as Object, Json As Object
Dim apiKey as String, apiURL as String, myOrigin as String, myDest As String
I have a VB.net application which needs to read and write Excel workbooks, using OLEDB and the MS Office Access Database driver. Over time, I have learned a vast amount here on StackOverflow which allowed me to get everything working the way it should be. Those topics covered everything from connectionstrings to the "magic" TypeGuessRows setting / 255 character limitation, now located in the registry. Over time, that issue by itself has morphed due to the evolutions by Microsoft over the years, so I won't reference those (hundreds? thousands?) of posts here. Suffice it to say that I was able to piece it all together and get it working.
For reference: my connectionstring looks like this:
"Provider=Microsoft.ACE.OLEDB.12.0;Data Source='#DBQ';Extended Properties='Excel 12.0 Xml;HDR=YES';"
where '#DBQ' is replaced at runtime by the appropriate pathname of the selected Excel workbook. Note that it does not contain TypeGuessRows (since that has moved to the registry), and IMEX=(whatever) has not effect either, so it does not appear. The result is that everything works quite well, AS LONG AS TYPEGUESSROWS is set to zero in the registry.
Using regedit to manually hunt down and set TypeGuessRows=0 in all occurrences (one of the things I learned about here on StackOverflow), this has worked and avoids the 255-char truncation perfectly.
The problem is that whenever there is a Windows update, it gets set back to the default value, 8. There is no warning or announcement of this; I only know about it when I start seeing the "truncated at 255 characters" symptom showing up again. So then I have to go back and use RegEdit again.
The obvious solution would be that the app does this setting on its own, but that seems to require manipulation of the Security features, which is something I'd prefer to avoid entirely as it seems to be more complex than I want to deal with presently.
So, I thought, "why not just scan the appropriate registry keys, and report if they are not zero", then issue a message to the user to get it sorted using regedit.
I wrote the following function, which looks at all of the various registry keys I have found which contain TypeGuessRows:
Public Function CheckRegistry() As Integer
Dim Val1 As Integer = 0, Val2 As Integer = 0
Dim KeysToCheck As String() = New String() {
"HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Jet\4.0\Engines\Excel",
"HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Jet\4.0\Engines\Lotus",
"HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Office\14.0\Access Connectivity Engine\Engines\Excel",
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\ClickToRun\REGISTRY\MACHINE\Software\Wow6432Node\Microsoft\Office\16.0\Access Connectivity Engine\Engines\Excel"
}
'
' try two methods for checking the registry values.
'
' method 1 uses the My.Computer class
'
For Each Key As String In KeysToCheck
Dim aVal As Object = My.Computer.Registry.GetValue(Key, "TypeGuessRows", CType("BOGUS", Object))
If IsNothing(aVal) Then ' did we hit Nothing?
Continue For ' have to skip it
ElseIf aVal.Equals(CType("BOGUS", Object)) Then ' did we hit one not exist?
Val1 = -9999 ' set a crazy value
End If
Val1 += CInt(aVal) ' otherwise, get its value and add to total
Next
'
' method 2 uses the RegistryKey class
'
Dim aKey As Microsoft.Win32.RegistryKey
For Each Key As String In KeysToCheck
Dim LM As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.LocalMachine ' point to HKLM
Key = Key.TrimStart("HKEY_LOCAL_MACHINE\".ToCharArray) ' peel off the start (a convenience)
aKey = LM.OpenSubKey(Key, Microsoft.Win32.RegistryKeyPermissionCheck.ReadSubTree) ' try to read the subkey
If IsNothing(aKey) Then Continue For ' did we hit Nothing? have to skip it
'If CInt(aKey.GetValue("TypeGuessRows", 0)) <> 0 Then aKey.SetValue("TypeGuessRows", 0)
Val2 += CInt(aKey.GetValue("TypeGuessRows", 0)) ' otherwise, get its value and add to total
Next
Return Val1 + Val2 ' return the sum of both methods
End Function
This works well enough, EXCEPT FOR THE LAST ONE, the one with "...ClickToRun..." in the key name.
No matter what, this ALWAYS returns as Nothing, so the attempt to check it fails. Even in the first method, where I specifically ask it to return a "BOGUS" object, it always returns as Nothing.
The problem is that it is THIS KEY which gets updated by Windows Update. Thus far I have never seen any of the other three get reset.
If I "walk the tree" of this key (i.e., try looking at "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office"), it works fine until I hit the ClickToRun branch, at which point it just returns Nothing.
So, I guess I have two questions:
Is there a way to read this key so that it does not return as Nothing?
Can someone provide a (hopefully not too messy / complex) guide to getting the Security settings correct to allow "ReadWriteSubTree" for the permission check? N.B. if I try that now, I get Security exception, telling me that the app does not have the appropriate permission. That's why the aKey.SetValue line is commented out.
Further info:
the machine is Win 10 Pro, 64-bit, with appropriate drivers installed. The app is set to "Enable ClickToRun security settings", and "full trust application". I have played with those settings and the appropriate entries in app.manifest, but thus far that only causes (much) other grief and difficulties elsewhere. That's why I'd prefer to not mess with it.
Any help would be really appreciated.
After some sleep, some more thought and in particular, some hints found [here]
Reading 64bit Registry from a 32bit application I managed to at least get the ability to read the registry keys.
The problem was that I was trying to "read" 64-bit registry keys from my 32-bit app.
Now I can do what I really wanted to do, which was to detect when the TypeGuessRows issue has cropped up again, and warn the user to do something about it.
Here is the modified code:
Public Function CheckRegistry() As Integer
Dim CheckVal As Integer = 0
Dim KeysToCheck As String() = New String() {
"SOFTWARE\WOW6432Node\Microsoft\Jet\4.0\Engines\Excel",
"SOFTWARE\WOW6432Node\Microsoft\Jet\4.0\Engines\Lotus",
"SOFTWARE\WOW6432Node\Microsoft\Office\14.0\Access Connectivity Engine\Engines\Excel",
"SOFTWARE\Microsoft\Office\ClickToRun\REGISTRY\MACHINE\Software\Wow6432Node\Microsoft\Office\16.0\Access Connectivity Engine\Engines\Excel"
}
Dim LMachine As Microsoft.Win32.RegistryKey =
Microsoft.Win32.RegistryKey.OpenBaseKey(Microsoft.Win32.RegistryHive.LocalMachine,
Microsoft.Win32.RegistryView.Registry64)
Dim LKey As Microsoft.Win32.RegistryKey
For Each Key As String In KeysToCheck
Try
LKey = LMachine.OpenSubKey(Key, Microsoft.Win32.RegistryKeyPermissionCheck.ReadSubTree)
CheckVal += CInt(LKey.GetValue("TypeGuessRows", 0))
Catch ex As Exception
LMachine.Close()
Return -9999
End Try
Next
LMachine.Close()
Return CheckVal
End Function
In testing this out, it can successfully check all four of the keys shown. The try-catch is never fired, but I left it there for safety anyway.
I hope that someone else might find this useful.
I've been writing code to process xml downloaded via a webservice API. I was going ok until one query had some mysterious characters before the root element.
After contacting the support, I got the following message...
"The ABS.Stat APIs resultant XML output are UTF-8 compliant. These characters are a UTF-8 Byte Order Mark designed to identify the xml as UTF-8. Hope this helps."
Whilst waiting for their reply I continued with my programming by simply starting my DOM processing at the opening tag (first "<") with the following code...
Dim lgRootElementStart As Long
lgRootElementStart = InStr(1, hReq.ResponseText, "<")
Dim sgResponse As String
sgResponse = Mid(hReq.ResponseText, lgRootElementStart)
Dim xmlDoc As New MSXML2.DOMDocument
If Not xmlDoc.LoadXML(sgResponse) Then
etc. etc. etc.
All seems to be well, the data is deciphered and displayed ok.
But now that I know what those characters are, is there anything I should do with those characters?
Or to put it another way, is there anything I can do with those characters to make my excel application more reliable? i.e. now that I know the XML is UTF-8, how should I process it differently?
What should I do if the BOM gives UTF-16?
Well it seems that the BOM is more a nuisance than helpful, but I placed code in my application to check that it is a UTF8 BOM if any characters before the xml root element are received. If it's not a UTF8 BOM then an error is thrown. I'm not expecting this to be a problem any more, but if I ever see the error then I will have to re-analyse what's going on. Hopefully that will never happen.
Code is...
Public Const BOM_UTF8 As String = ""
and
If lgRootElementStart > 1 Then
If Left(hReq.ResponseText, lgRootElementStart - 1) = BOM_UTF8 Then
Else
Err.Raise ERROR_SHOULD_NEVER_HAPPEN, sFunctionName, _
"Non UTF8 BOM found. " _
& "BOM is ..." & ConvertToHex(Left(hReq.ResponseText, lgRootElementStart - 1)) _
& ", correct BOM is ... " & ConvertToHex(BOM_UTF8)
End If
End If
One quote from a link in the comments says..."Encodings should be known, not divined". Well with this code I know it's UTF8 if I get it.
I would like to cycle through several hundreds of XBRL-files automatically and gather certain specific pieces of data and paste them into an excel sheet. I managed to get the "tangential code" working, but cannot answer the core question.
E.g., in the XBRL file I need the value of this fact, reported against the concept pfs:GainLossBeforeTaxes:
<pfs:GainLossBeforeTaxes
unitRef="U-EUR"
decimals="INF"
contextRef="CurrentDuration">1091134.68</pfs:GainLossBeforeTaxes>
==> I need to obtain 1091134.68
This is doubtlessly something which is easy with Regex, but I cannot seem to get this working. And time constraints are also a thing for me, so I would like to obtain some sort of minimal viable product so far and later on expand that, but at this point the code is more of a means to an end, rather than the endproduct (analysis) itself.
So far, I came up with the following:
Sub EDI_Input()
Dim myFile As String
Dim textline As String
Dim StartPos As Integer
Dim EndPos As Integer
myFile = Application.GetOpenFilename()
Open myFile For Input As #EDI
Do Until EOF(EDI)
Line Input #EDI, textline
If InStr(textline, "NonRecurringFinancialCharges") <> 0 And InStr(textline, "CurrentDuration") <> 0 Then
Endpos = InStr(textline, "</pfs:NonRecurringFinancialCharges><")
result = Left(textline, Endpos - 1)
StartPos = InStr(textline, "Char(34)&CurrentDuration&Char(34)&>")
textline = Left(textline, StartPos + 18)
Debug.Print (textline)
End If
Loop
I keep stumbling on the "invalid call procedure or argument error", possible because I load to many data in my string.
Anybody who has any opinion on how to get at least a partially working programma - in that way I can at least partially start my analysis - Or a tutorial for beginners/experience with this problem?
Welcome to StackOverflow!
I recommend using an XBRL processor, for example Arelle, which is open source. If I correctly remember, you should be able to export facts to formats like CSV and import it into Excel.
Otherwise, you will end up reimplementing an XBRL processor in VBA. There are many involved details to consider in order to get the correct values (joining with context, considering dimensions, etc). Values could be reported against a concept for multiple periods, etc.
An XBRL processor will do that out of the box.
I have found plenty of vba for inserting images into a comment
Selection.ShapeRange.Fill.UserPicture "C:\Temp\Pictures\ewe.jpg"
How can you determine the image already used for an comment?
I would like to extract the embedded image names if possible.
Is there not a property to access that will give me this?
In the comment Fill Effects dialog box the image name somehow seems to be accessible.
Sorry, I didn't have the reputation to just comment on your question for clarification.
I made a test file, inserted a comment and image in that comment, and then extracted the base files. I then checked them all for the original file name. I also found the embedded JPEG and decoded it to get the metadata. As you've noted, the original file names are stored in xl\drawings\vmlDrawing1.vml (once you've extracted the xml files from the excel file by appending .zip to the filename and then running an unzip utility on it). I did find the file name, but not the path or file type, so I'm fairly certain that the path and file type aren't preserved.
If just the file name is sufficient for you, then that file contains information for each drawing that you have, and those will include the cell location, although they're 0 based, so you'd have to add one to get the actual row and column. My question is two part:
1) Is the file name alone sufficient, or did you need the entire path? If you needed the entire path, I think you're out of luck, since the paths are on a different computer and you can't even search for them if you do extract the file name.
2) If that is all you need, does the solution have to be VBA? In the past, I have programmatically unzipped and manipulated the xml base files, but it's a little tricky. It's simplified by the fact that you only have to read out the data, so that's a plus. I did it in .net before, but I'm sure that if it had to be VBA it could be done, but it would be simpler if you were open to the type of solution.
Let me know, I'd be happy to help you out.
====================================================================================
Try this: make a copy of the spreadsheet, append .zip (test.xlsm.zip), and then extract the files manually. Change vmlPath to the location of your xl\drawings\vmlDrawing1.vml file. Then run this. I did make some assumptions, for instance, I assumed that the order of the nodes and attributes would always be the same and so I used hardcoded indexes (shp.attributes(0), etc) instead of using logic to make sure I had the correct node or attribute, but you seem like you know your way around VBA, so I'm just going to code a barebones. This will need a reference to Microsoft XML 6.0.
Sub vmlParse()
Dim vmlPath As String: vmlPath = "C:\Users\Lenovo\Desktop\test - Copy.xlsm\xl\drawings\vmlDrawing1.vml"
Dim this As Worksheet: Set this = ActiveSheet
Dim doc As New DOMDocument, shps As IXMLDOMNodeList
Dim shp As IXMLDOMNode, n As IXMLDOMNode, a As IXMLDOMAttribute
Dim fileName As String, productID As String
Dim rng As Range, r As Long, c As Long
doc.Load vmlPath
Set shps = doc.getElementsByTagName("x:ClientData")
For Each shp In shps
If shp.Attributes(0).nodeValue = "Note" Then
r = 0: c = 0
For Each a In shp.ParentNode.FirstChild.Attributes
If a.nodeName = "o:title" Then
fileName = a.nodeValue
Exit For
End If
Next
For Each n In shp.childNodes
If n.nodeName = "x:Row" Then r = n.text
If n.nodeName = "x:Column" Then c = n.text
Next
Set rng = this.Cells(r + 1, c + 1)
productID = rng.Value
'now you have the productID, the fileName, and the cell location
End If
Next
End Sub
Let me know how that worked out for you.
If c4 contains your comment:
Set shp = Range("C4").Comment.Shape
if shp.Fill.TextureType = msoTextureUserDefined then
end if