Link to home
Start Free TrialLog in
Avatar of mikexml
mikexml

asked on

Web XML Request Written to TextFile Object with Foreign Character Sets

I have trying to download data from a website using the MSXML2.XMLHTTP.6.0 object and writing to a Scripting.FileSystemObject.
I create a new .xml file (one per Month per Country per RegistryCountry) for each loop through the data and all goes well for 2008 but when I get to Greece ("GR") in 2009, it churns out the error that an invalid call has been invoked. There is no data at all in 2008 for Greece and none in 01 & 02 months so 03 2009 is the first month that it encounters Greek Character sets.

How do I adjust the text file object so that it will accept the writing of  the foreign characters?

It fails at - ts.Write result - as I try to write the Greek result. It also fails at other foreign characters - so I need to embrace a universal storage text file.

[/

Private Sub Workbook_Open()
   
     
    Dim XMLHTTP
    Dim result As String
    Dim argumentString
    Dim fso As New Scripting.FileSystemObject
    Dim fl As Scripting.File
    Dim ts As Scripting.TextStream
    
    zz = ActiveWorkbook.Path


On Error GoTo errHandler:

     
Dim strArgument(1 To 24) As String


strArgument(1) = "destinationAccountHolder=&"
strArgument(2) = "startDate=01%2F03%2F2008&"
strArgument(3) = "destinationRegistry=-1&"
strArgument(4) = "originatingAccountType=121&"   'Default=-1&
strArgument(5) = "form=transaction&"
strArgument(6) = "endDate=28%2F03%2F2008&"
strArgument(7) = "transactionID=&"
strArgument(8) = "originatingAccountHolder=&"
strArgument(9) = "suppTransactionType=-1&"
strArgument(10) = "transactionType=-1&"
strArgument(11) = "languageCode=en&"
strArgument(12) = "destinationAccountNumber=&"
strArgument(13) = "destinationAccountType=121&"    'Default=-1&
strArgument(14) = "toCompletionDate=&"
strArgument(15) = "originatingRegistry=GR&"
strArgument(16) = "destinationAccountIdentifier=&"
strArgument(17) = "fromCompletionDate=&"
strArgument(18) = "originatingAccountIdentifier=&"
strArgument(19) = "transactionStatus=4&"
strArgument(20) = "originatingAccountNumber=&"
strArgument(21) = "currentSortSettings=&"
strArgument(22) = "form=transaction&"
strArgument(23) = "exportType=1&"
strArgument(24) = "OK=OK"


Dim myYearArray As Variant
Dim thisYearArray As Variant
myYearArray = Array("2008", "2009", "2010", "2011", "2012")


For Each thisYearArray In myYearArray

         
Dim myMonthArray As Variant
Dim thisMonthArray As Variant
myMonthArray = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")

For Each thisMonthArray In myMonthArray



Dim myCountryArray As Variant
Dim thisCountryArray As Variant
myCountryArray = Array("AT", "BE", "BG", "HR", "CY", "CZ", "DK", "ED", "EE", "EU", "FI", "FR", "DE", "GR", "HU", "IS", "IE", "IT", "LV", "LI", "LT", "LU", "MT", "NL", "NO", "PL", "PT", "RO", "SK", "SI", "ES", "SE", "GB") '"AT", "BE", "BG", "HR", "CY", "CZ", "DK", "ED", "EE", "EU", "FI", "FR", "DE", "GR", "HU", "IS", "IE", "IT", "LV", "LI", "LT", "LU", "MT", "NL", "NO", "PL", "PT", "RO", "SK", "SI", "ES", "SE", "GB")
'greece problem
           
For Each thisCountryArray In myCountryArray


strArgument(2) = "startDate=01%2F" & CStr(thisMonthArray) & "%2F" & CStr(thisYearArray) & "&"
strArgument(6) = "endDate=31%2F" & CStr(thisMonthArray) & "%2F" & CStr(thisYearArray) & "&"
strArgument(15) = "originatingRegistry=" & CStr(thisCountryArray) & "&"
        
        
argumentString = ""

For x = 1 To 24

    argumentString = argumentString & strArgument(x)

Next x

Set XMLHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
    XMLHTTP.Open "POST", _
    "http://ec.europa.eu/environment/ets/export.do", False
    XMLHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    XMLHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
    XMLHTTP.send argumentString
    result = XMLHTTP.responseText
   ' MsgBox result
    result = Replace(result, "encoding=" & Chr(34) & "UTF-8", "encoding=" & Chr(34) & "iso-8859-1")
    fso.CreateTextFile zz & "\" & originatingRegistry & CStr(thisMonthArray) & CStr(thisYearArray) & ".xml"
    Set fl = fso.GetFile(zz & "\" & originatingRegistry & CStr(thisMonthArray) & CStr(thisYearArray) & ".xml")
    Set ts = fl.OpenAsTextStream(ForWriting)
    ts.Write result
    ts.Close
    Set ts = Nothing
    Set fl = Nothing
    Set fso = Nothing
    Set XMLHTTP = Nothing
    post_html = "OK"
    
     
Next

Next

Next

Exit Sub


errHandler:

MsgBox (thisCountryArray & " " & thisMonthArray & " " & thisYearArray)
MsgBox argumentString
MsgBox Err & ": " & Error(Err)


'ActiveWorkbook.Close False

Exit Sub


End Sub

]

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Theo Kouwenhoven
Theo Kouwenhoven
Flag of Netherlands image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of mikexml
mikexml

ASKER

Thanks. How do I do that. I presume I can change the replace from UTF-8 to UTF-16 or did you mean UFT-8, utf-16 i.e.both? But how do I alter or detect the codepage(ccsid) of your Result file is 1208??