I have a problem posting to facebook wall with classic asp. The variables fbName, fbUserID, accessToken are set in "real life" - i just deleted it here. I have the correct permissions for posting to a users wall ("publish_stream").
The post is not posted on the facebook wall of the user. Did I make any mistakes?
fbName = ""
fbUserID = ""
accessToken = ""
strURL = "https://graph.facebook.com/" & fbUserID & "/feed"
strMessage = fbName & " just did something."
strLink = "http://www.orf.at/"
strAccessToken = accessToken
para = "?access_token=" & strAccessToken & "&message=" & strMessage & "&link=" & strLink
set xmlDoc = createObject("MSXML2.DOMDocument")
xmlDoc.async = False
xmlDoc.setProperty "ServerHTTPRequest", true
bLoaded = xmlDoc.load(strURL & para)
i am sorry, i can't answer my own question. But here is the correct solution:
The correct answer is:
Dim xmlHttp
Dim res
set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlHttp.Open "POST", strURL & para, false
xmlHttp.setRequestHeader "Content-type","application/x-www-form-urlencoded"
xmlHttp.send
To fetch some errors:
res = xmlHttp.responseText
Response.Write "res: " & res & "<br>"
Response.Write "Status: " & xmlHttp.Status & "<br>"
It looks like you're not using a Http Post request. You need something like this(untested)
Dim xmlHttp
set xmlHttp = CreateObject("Microsoft.xmlHttp")
xmlHttp.Open "POST", strURL & para
xmlHttp.setRequestHeader "Content-type","application/x-www-form-urlencoded"
xmlHttp.setRequestHeader "Content-Length",len(sendData)
xmlHttp.send
Dim response
response = xmlHttp.responseText
Related
I am attempting (and can successfully do so) to connect to an API and loop through several iterations of the API call in order to grab the next_page value, put it in a list and then call the list.
Unfortunately, when this is published to the PBI service I am unable to refresh there and indeed 'Data Source Settings' tells me I have a 'hand-authored query'.
I have attempted to follow Chris Webbs' blog post around the usage of query parameters and relative path, but if I use this I just get a constant loop of the first page that's hit.
The Start Epoch Time is a helper to ensure I only grab data less than 3 months old.
let
iterations = 10000, // Number of MAXIMUM iterations
url = "https://www.zopim.com/api/v2/" & "incremental/" & "chats?fields=chats(*)" & "&start_time=" & Number.ToText( StartEpochTime ),
FnGetOnePage =
(url) as record =>
let
Source1 = Json.Document(Web.Contents(url, [Headers=[Authorization="Bearer MY AUTHORIZATION KEY"]])),
data = try Source1[chats] otherwise null, //get the data of the first page
next = try Source1[next_page] otherwise null, // the script ask if there is another page*//*
res = [Data=data, Next=next]
in
res,
GeneratedList =
List.Generate(
()=>[i=0, res = FnGetOnePage(url)],
each [i]<iterations and [res][Data]<>null,
each [i=[i]+1, res = FnGetOnePage([res][Next])],
each [res][Data])
Lookups
If Source1 exists, but [chats] may not, you can simplify
= try Source1[chats] otherwise null
to
= Source1[chats]?
Plus it you don't lose non-lookup errors.
m-spec-operators
Chris Web Method
should be something closer to this.
let
Headers = [
Accept="application/json"
],
BaseUrl = "https://www.zopim.com", // very important
Options = [
RelativePath = "api/v2/incremental/chats",
Headers = [
Accept="application/json"
],
Query = [
fields = "chats(*)",
start_time = Number.ToText( StartEpocTime )
],
Response = Web.Contents(BaseUrl, Options),
Result = Json.Document(Response) // skip if it's not JSON
in
Result
Here's an example of a reusable Web.Contents function
helper function
let
/*
from: <https://github.com/ninmonkey/Ninmonkey.PowerQueryLib/blob/master/source/WebRequest_Simple.pq>
Wrapper for Web.Contents returns response metadata
for options, see: <https://learn.microsoft.com/en-us/powerquery-m/web-contents#__toc360793395>
Details on preventing "Refresh Errors", using 'Query' and 'RelativePath':
- Not using Query and Relative path cause refresh errors:
<https://blog.crossjoin.co.uk/2016/08/23/web-contents-m-functions-and-dataset-refresh-errors-in-power-bi/>
- You can opt-in to Skip-Test:
<https://blog.crossjoin.co.uk/2019/04/25/skip-test-connection-power-bi-refresh-failures/>
- Debugging and tracing the HTTP requests
<https://blog.crossjoin.co.uk/2019/11/17/troubleshooting-web-service-refresh-problems-in-power-bi-with-the-power-query-diagnostics-feature/>
update:
- MaybeErrResponse: Quick example of parsing an error result.
- Raw text is returned, this is useful when there's an error
- now response[json] does not throw, when the data isn't json to begin with (false errors)
*/
WebRequest_Simple
= (
base_url as text,
optional relative_path as nullable text,
optional options as nullable record
)
as record =>
let
headers = options[Headers]?, //or: ?? [ Accept = "application/json" ],
merged_options = [
Query = options[Query]?,
RelativePath = relative_path,
ManualStatusHandling = options[ManualStatusHandling]? ?? { 400, 404, 406 },
Headers = headers
],
bytes = Web.Contents(base_url, merged_options),
response = Binary.Buffer(bytes),
response_metadata = Value.Metadata( bytes ),
status_code = response_metadata[Response.Status]?,
response_text = Text.Combine( Lines.FromBinary(response,null,null, TextEncoding.Utf8), "" ),
json = Json.Document(response),
IsJsonX = not (try json)[HasError],
Final = [
request_url = metadata[Content.Uri](),
response_text = response_text,
status_code = status_code,
metadata = response_metadata,
IsJson = IsJsonX,
response = response,
json = if IsJsonX then json else null
]
in
Final,
tests = {
WebRequest_Simple("https://httpbin.org", "json"), // expect: json
WebRequest_Simple("https://www.google.com"), // expect: html
WebRequest_Simple("https://httpbin.org", "/headers"),
WebRequest_Simple("https://httpbin.org", "/status/codes/406"), // exect 404
WebRequest_Simple("https://httpbin.org", "/status/406"), // exect 406
WebRequest_Simple("https://httpbin.org", "/get", [ Text = "Hello World"])
},
FinalResults = Table.FromRecords(tests,
type table[
status_code = Int64.Type, request_url = text,
metadata = record,
response_text = text,
IsJson = logical, json = any,
response = binary
],
MissingField.Error
)
in
FinalResults
I am using the Python Zeep library to call Maximo web services and able to fetch the WSDL without any issues. When I am trying to query using one of the method in Web service, it is throwing error
requests.exceptions.ConnectionError: ('Connection aborted.', RemoteDisconnected('Remote end closed connection without response',))
multiasset_wsdl = "http://maximoqa.xyz.com:9080/meaweb/services/MULTIASSET?wsdl"
work_order = 'NA0000211'
# set the session
session = Session()
session.auth = HTTPBasicAuth(Username, Password)
session.verify = False
transport = Transport(session=session)
settings = Settings(strict=False ,force_https = False)
maximo_multiasset_client = Client(multiasset_wsdl, transport=transport, settings=settings
multiasset_type_factory = maximo_multiasset_client.type_factory('ns0')
mult_asset_query = multiasset_type_factory.QueryMULTIASSETType(
baseLanguage = "?",
creationDateTime = tt.get_now(),
maximoVersion = "?",
maxItems = "1",
messageID = "?",
rsStart = "0",
transLanguage = "EN",
uniqueResult = False,
MULTIASSETQuery = multiasset_type_factory.MULTIASSETQueryType
(
operandMode = multiasset_type_factory.OperandModeType('AND'),
orderby = "?",
WHERE = f"WONUM='{work_order}'",
WORKORDER = None
)
)
print('Calling Query MultiAsset')
query_response = maximo_multiasset_client.service.QueryMULTIASSET(mult_asset_query)
Appreciate any help on this issue.
I'm trying to fetch two fields from each container from some json response using regex. When I execute the script that I've written so far can produce the two fields from all the containers. However, the way I've defined the last loop doesn't seem to be an ideal one. To be clearer, I used the count of name and created a loop to parse the required fields. If the count of names and changeAmount are different the results will be real messy. How can I rectify the loop to scrape the two fields in the right way?
I've tried with (working script):
Sub FetchContent()
Const Url$ = "https://api-global.morningstar.com/sal-service/v1/stock/ownership/v1/0P000000GY/OwnershipData/mutualfund/20/data?locale=en&clientId=MDC&benchmarkId=category&version=3.21.1"
Dim elem As Object, oelem As Object, I&, R&, S$
Dim Http As Object, Rgxp As Object, wb As Workbook, ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")
Set Http = CreateObject("MSXML2.XMLHTTP")
Set Rgxp = CreateObject("VBScript.RegExp")
With Http
.Open "GET", Url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; ) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/81.0.4044.138 Safari/537.36"
.setRequestHeader "ApiKey", "lstzFDEOhfFNMLikKa0am9mgEKLBl49T"
.send
S = .responseText
End With
With Rgxp
.Global = True
.MultiLine = True
.Pattern = "name"":""(.*?)"""
Set elem = .Execute(S)
.Pattern = "changeAmount"":(.*?),"
Set oelem = .Execute(S)
End With
For I = 0 To elem.Count - 1
R = R + 1: ws.Cells(R, 1) = elem(I).SubMatches(0)
ws.Cells(R, 2) = oelem(I).SubMatches(0)
Next I
End Sub
The following content represents how the first three containers look like:
{
"secId": "FOUSA00FQU",
"name": "Vanguard Total Stock Mkt Idx Inv",
"totalSharesHeld": 2.564925871507663,
"totalAssets": 4.16033,
"currentShares": 115913617,
"changeAmount": -1331374,
"changePercentage": -1.1355487246359206,
"date": "2020-04-30T00:00:00.000",
"trend": "_PO_",
"starRating": "4"
},
{
"secId": "FOUSA00FS1",
"name": "Vanguard 500 Index Investor",
"totalSharesHeld": 1.8912105957275436,
"totalAssets": 5.08629,
"currentShares": 85467211,
"changeAmount": -487891,
"changePercentage": -0.5676114490562759,
"date": "2020-04-30T00:00:00.000",
"trend": "_PO_",
"starRating": "4"
},
{
"secId": "FEUSA00001",
"name": "SPDR\u00ae S&P 500 ETF Trust",
"totalSharesHeld": 0.994538610986949,
"totalAssets": 5.07929,
"currentShares": 44944990,
"changeAmount": -436740,
"changePercentage": -0.9623696584506585,
"date": "2020-04-30T00:00:00.000",
"trend": "_PO_",
"starRating": "5"
}
How can I fetch the two fields from all the containers?
PS I'm not after any solution related to any json converter.
Option Explicit
Sub FetchContent()
Const url = "https://api-global.morningstar.com/sal-service/v1/stock/ownership/v1/0P000000GY/OwnershipData/mutualfund/20/data?locale=en&clientId=MDC&benchmarkId=category&version=3.21.1"
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Worksheets("Sheet1")
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; ) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/81.0.4044.138 Safari/537.36"
.setRequestHeader "ApiKey", "lstzFDEOhfFNMLikKa0am9mgEKLBl49T"
.send
Dim resp
resp = .responseText
End With
With CreateObject("VBScript.RegExp")
.Global = True
.MultiLine = True
.pattern = "\{[^}]*""name""\:""(.*?)"",.*?""changeAmount""\:([-.\d]*),"
Dim r
r = 1
Dim item
For Each item In .Execute(resp)
ws.Cells(r, 1) = decodeJsonString(item.SubMatches(0))
ws.Cells(r, 2) = decodeJsonString(item.SubMatches(1))
r = r + 1
Next
End With
End Sub
Function decodeJsonString(jsonString)
With CreateObject("VBScript.RegExp")
.Global = True
.MultiLine = True
decodeJsonString = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
jsonString, _
"\""", """"), _
"\\", "\" & vbNullChar), _
"\/", "/"), _
"\b", Chr(8)), _
"\f", Chr(12)), _
"\n", vbLf), _
"\r", vbCr), _
"\t", vbTab)
.Global = False
.pattern = "\\u[0-9a-fA-F]{4}"
Do While .test(decodeJsonString)
decodeJsonString = .Replace(decodeJsonString, ChrW(("&H" & Right(.Execute(decodeJsonString)(0).Value, 4)) * 1))
Loop
decodeJsonString = Replace(decodeJsonString, "\" & vbNullChar, "\")
End With
End Function
You forgot opening quote:
.Pattern = """name"":""(.*?)"""
.Pattern = """changeAmount"":(.*?),"
This is another way I found success with apart from what omegastripes has showed in his answer:
Sub FetchContent()
Const Url$ = "https://api-global.morningstar.com/sal-service/v1/stock/ownership/v1/0P000000GY/OwnershipData/mutualfund/20/data?locale=en&clientId=MDC&benchmarkId=category&version=3.21.1"
Dim elem As Object, I&, R&, S$, wb As Workbook
Dim Http As Object, Rgxp As Object, ws As Worksheet
Dim subElem As Object, subElemAno As Object
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")
Set Http = CreateObject("MSXML2.XMLHTTP")
Set Rgxp = CreateObject("VBScript.RegExp")
With Http
.Open "GET", Url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; ) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/81.0.4044.138 Safari/537.36"
.setRequestHeader "ApiKey", "lstzFDEOhfFNMLikKa0am9mgEKLBl49T"
.send
S = .responseText
End With
With Rgxp
.Global = True
.MultiLine = True
.Pattern = "{""secId[\s\S]+?}"
Set elem = .Execute(S)
For I = 0 To elem.Count - 1
.Pattern = "name"":""(.*?)"""
Set subElem = .Execute(elem(I).Value)
If subElem.Count > 0 Then
R = R + 1: ws.Cells(R, 1) = subElem(0).SubMatches(0)
End If
.Pattern = "changeAmount"":(.*?),"
Set subElemAno = .Execute(elem(I).Value)
If subElemAno.Count > 0 Then
ws.Cells(R, 2) = subElemAno(0).SubMatches(0)
End If
Next I
End With
End Sub
Sub UpdateDMDCLCSIM()
Dim SIM_DM_DCLC As Worksheet
Dim TextFileUpdated As Date
Set SIM_DM_DCLC = ThisWorkbook.Sheets(Sheet52.Name)
TextFileUpdated = DateValue(FileDateTime("\\networkshare\dept\DCGSI\Extracts\SIM_DM_DCLC.csv"))
Application.DisplayAlerts = False
Application.StatusBar = "Importing latest DM DCLC SIM Data..."
With SIM_DM_DCLC.QueryTables.Add(Connection:= _
"TEXT;\\networkshare\dept\DCGSI\Extracts\SIM_DM_DCLC.csv" _
, Destination:=SIM_DM_DCLC.Range("$A$1"))
.Name = "SIM_DM_DCLC"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'Change to MySQL date format.
SIM_DM_DCLC.Range("I:K", "P:T").Replace Chr(84), " "
SIM_DM_DCLC.Range("I:K", "P:T").Replace Chr(90), ""
SIM_DM_DCLC.Range("I:K", "P:T").NumberFormat = "yyyy-mm-dd hh:mm:ss"
Okay so this opens a csv that is downloaded to a network share and fixes some dates. The dates in the original file are formatted YYYY-MM-DDTHH:MM:SSZ and this is supposed to strip the T and Z from those dates in the appropriate columns. The issue I am having is that for some strange reason it is processing column L in the file and I can't figure out why.
So I looked up some code for regex replace in VBA and tried to refactor the code to use the following code to try and fix the issue:
Sub UpdateDMDCLCSIM()
On Error GoTo ErrorHandler
Dim SIM_DM_DCLC As Worksheet
Dim TextFileUpdated As Date
Set SIM_DM_DCLC = ThisWorkbook.Sheets(Sheet52.Name)
TextFileUpdated = DateValue(FileDateTime("\\networksharem\dept\DCGSI\Extracts\SIM_DM_DCLC.csv"))
Application.DisplayAlerts = False
Application.StatusBar = "Importing latest DM DCLC SIM Data..."
With SIM_DM_DCLC.QueryTables.Add(Connection:= _
"TEXT;\\networkshare\dept\DCGSI\Extracts\SIM_DM_DCLC.csv" _
, Destination:=SIM_DM_DCLC.Range("$A$1"))
.Name = "SIM_DM_DCLC"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'Change to MySQL date format.
Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "/^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z)$/"
For Each cell In SIM_DM_DCLC.UsedRange
If cell.Value <> "" Then cell.Value = regex.Replace(cell.Value, "/^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})$/")
Next cell
Pretty sure that the 5017 - Application-defined or object-defined error I am getting on the regex.Replace means I have something wrong with the regex piece. Just not sure what it is.
Well you have to check to an actual match and not just a blank; here is the updated and appropriate section of code.
'Change to MySQL date format.
Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})Z)$"
For Each cell In SIM_DM_DCLC.UsedRange
If cell.Value = regex.Pattern Then cell.Value = regex.Replace(cell.Value, "^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})$")
Next cell
I am trying to store data in vtiger leads module. i can send variable via file_get_contents()
but its not working . here is my code
$moduleName = $_POST['moduleName'];
$company = $_POST['company'];
$firstname = $_POST['firstname'];
$lastname = $_POST['lastname'];
$website = $_POST['website'];
$phone = $_POST['phone'];
$email = $_POST['email'];
$city = $_POST['city'];
$state = $_POST['state'];
$code = $_POST['code'];
$post = http_build_query(array(
"firstname" => "$firstname",
"lastname" => "$lastname",
"website"=>"$website",
"phone"=>"$phone",
"email"=>"$email",
"city"=>"$city",
"state"=>"$state",
"code"=>"$code",
"moduleName" => "$moduleName",
"company " => "$company",
));
$context = stream_context_create(array("http"=>array(
"method" => "POST",
"header" => "Content-Type: application/x-www-form-urlencoded\r\n" .
"Content-Length: ". strlen($post) . "\r\n",
"content" => $post,
)));
$page = file_get_contents("http://vtiger.com/modules/Webforms/post.php", false, $context);
Please help me.
Use web forms correctly, in vtiger 5.4 you can create webforms ealsily with its interface. oru user vtiger webservices to create,edit,delte data