Trying to Export the Data from Clockify - vba

I have been trying to extract all the data from Clockify into Excel using VBA and using below code but there is no output coming with that code
Your help will be much appreciated.
Getting this reponse when run the code {"code":405,"message":"HTTP 405 Method Not Allowed"}
Public Sub GetAllProjects()
Dim httpCaller As MSXML2.XMLHTTP60
Set httpCaller = New MSXML2.XMLHTTP60
httpCaller.Open "GET", "https://reports.api.clockify.me/v1/workspaces/*****/reports/detailed"
httpCaller.setRequestHeader "X-Api-Key", CLOCKIFY_API_KEY
httpCaller.setRequestHeader "Content-Type", "application/json"
httpCaller.send
Debug.Print httpCaller.responseText
End Sub

A POST would look something like this in VBA:
Public Sub GetAllProjects()
Dim httpCaller As MSXML2.XMLHTTP60, body As String, obj As Object, json As Object, result
Dim ti As Object
'not sure how much of the request body is required....
'adjust dates below as needed
body = "{""dateRangeStart"": ""2020-05-10T00:00:00.000"", " & vbLf & _
" ""dateRangeEnd"": ""2020-05-16T23:59:59.000"", " & vbLf & _
" ""detailedFilter"": {""page"": 1,""pageSize"": 50}} "
Debug.Print body
Set httpCaller = New MSXML2.XMLHTTP60
With httpCaller
.Open "POST", "https://reports.api.clockify.me/v1/workspaces/*****/reports/detailed"
.setRequestHeader "X-Api-Key", CLOCKIFY_API_KEY
.setRequestHeader "Content-Type", "application/json"
.send body 'include JSON body
result = .responseText
Debug.Print "---Response---" & vbLf & result
End With
Set json = JsonConverter.ParseJson(result)
For Each obj In json("totals")
Debug.Print "------"
Debug.Print obj("totalTime")
Debug.Print obj("totalBillableTime")
Debug.Print obj("entriesCount")
Debug.Print obj("totalAmount")
Next obj
For Each obj In json("timeentries")
Debug.Print "------"
Debug.Print obj("_id")
Debug.Print obj("description")
'etc etc
'access the "timeinterval" sub-dictionary
Set ti = obj("timeInterval")
Debug.Print , ti("start")
Debug.Print , ti("end")
Debug.Print , ti("duration")
Next obj
End Sub

Related

Can't figure out the right way to break a long parameter to multiple lines

I've created a script to fetch json response from a website. To get the response I had to issue post http requests along with appropriate parameters. The script is doing fine.
The payload that I've used within the script is substantially long. It could have been longer.
Now, my question is, how can I break such long line to multiple lines?
This is how I've tried:
Sub GetJsonResponse()
Const URL = "https://api.pcexpress.ca/product-facade/v3/products/category/listing"
Dim payload$
payload = "{""pagination"":{""from"":2,""size"":48},""banner"":""loblaw"",""cartId"":""702da51e-a7ab-4f54-be5e-5bf38bd6d7a2"",""lang"":""en"",""date"":""09062021"",""storeId"":""1032"",""pcId"":null,""pickupType"":""STORE"",""enableSeldonIntegration"":true,""features"":[""loyaltyServiceIntegration"",""sunnyValeServiceIntegration""],""inventoryInfoRequired"":true,""sort"":{""topSeller"":""desc""},""categoryId"":""27985""}"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", URL, False
.setRequestHeader "content-type", "application/json;charset=UTF-8"
.setRequestHeader "x-apikey", "1im1hL52q9xvta16GlSdYDsTsG0dmyhF"
.send (payload)
Debug.Print .responseText
End With
End Sub
Use the & concatenation to join smaller parts. I would personally examine the json structure and then decide on logical breaks (within reason), then transfer to a text editor and use regex/ find and replace to generate the new strings to concatenate based on your chosen line breaks.
Below you will see most lines have payload = payload & " at the start and " at the end, after the break indicated by the ,.
Of course, also replacing inner " with "".
Option Explicit
Sub GetJsonResponse()
Const URL = "https://api.pcexpress.ca/product-facade/v3/products/category/listing"
Dim payload$
payload = "{""pagination"": {""from"": 2,""size"": 48},"
payload = payload & """banner"": ""loblaw"","
payload = payload & """cartId"": ""702da51e-a7ab-4f54-be5e-5bf38bd6d7a2"","
payload = payload & """lang"": ""en"","
payload = payload & """date"": ""09062021"","
payload = payload & """storeId"": ""1032"","
payload = payload & """pcId"": null,"
payload = payload & """pickupType"": ""STORE"","
payload = payload & """enableSeldonIntegration"": true,"
payload = payload & """features"": [""loyaltyServiceIntegration"", ""sunnyValeServiceIntegration""],"
payload = payload & """inventoryInfoRequired"": true,"
payload = payload & """sort"": {""topSeller"": ""desc""},"
payload = payload & """categoryId"": ""27985""}"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", URL, False
.setRequestHeader "content-type", "application/json;charset=UTF-8"
.setRequestHeader "x-apikey", "1im1hL52q9xvta16GlSdYDsTsG0dmyhF"
.send payload
Debug.Print .responseText
End With
End Sub
This fits with how I re-arranged this:
To this:
As you noted in the comments, you can absolutely split the string into pieces and continue the line with the line continuation character _.
Using the Windows Clipboard API functions from here:
https://learn.microsoft.com/en-us/office/vba/access/concepts/windows-api/send-information-to-the-clipboard
You can copy text to the clipboard and do something like:
Sub ClipboardTextToVbaString()
Dim s As String, arr, e, rv As String, i As Long, n As Long
s = GetClipboard() 'read text from clipboard
If Len(s) = 0 Then Exit Sub
arr = Split(s, vbCrLf)
rv = "s = "
For i = LBound(arr) To UBound(arr)
e = Replace(arr(i), """", """""")
rv = rv & """" & e & """ "
If i < UBound(arr) Then
If n < 20 Then
rv = rv & " & vbCRLf & _" & vbCrLf
n = n + 1
Else
rv = rv & " & vbCRLf" & vbCrLf & "s = s & "
n = 0
End If
End If
Next i
'Debug.Print rv
SetClipboard rv 'set the modified text back into the clipboard for pasting
End Sub
Not very thoroughly-tested but you get the idea: something for your personal.xlsb file...
Note this is more aimed at formatting multi-line text into a VB-compatible format - not really for breaking up long single lines, which I guess was your original form.

Sending local photos via VBA to Telegram

I'm trying to send a local photo using VBA or VBScript. The solutions I found are either for sending URLs instead of files, or for other than VBA or VBScript.
Sub TelegramAuto()
Dim ws As Worksheet
Set ws = Sheets("hidden")
Set ws1 = Sheets("Dashboard")
Dim objRequest As Object
Dim strChatId As String
Dim strMessage As String
Dim strPhoto As String
Dim strPostPhoto As String
Dim strPostData As String
Dim strResponse As String
strChatId = <id>
strMessage = ws.Range("J5") & Format(ws1.Range("D2"), "mm/dd/yyyy") & " " & ws1.Range("D4") & " " & ws1.Range("D6") _
& " " & ws1.Range("K6")
strPhoto = "C:/Users/mhjong/Desktop/GP_FS_Breakdown.png"
strPostData = "chat_id=" & strChatId & "&text=" & strMessage
strPostPhoto = "chat_id=" & strChatId & "&photo=" & strPhoto
Set objRequest = CreateObject("MSXML2.XMLHTTP")
With objRequest
.Open "POST", "https://api.telegram.org/bot<token>/sendMessage?", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send (strPostData)
End With
With objRequest
.Open "POST", "https://api.telegram.org/bot<token>/sendPhoto?", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Send (strPostPhoto)
End With
End Sub
I can send messages. I cannot find the syntax to upload a local image and send it to Telegram.
strPhoto = "image link"
strPostPhoto = "chat_id=" & strChatId & "&photo=" & strPhoto
With objRequest
.Open "POST", "https://api.telegram.org/bot<Token>/sendPhoto?" & strPostPhoto, False
.send
End With
Public Function tmBotSend(Token As String, chat_id As String, Optional text As String = "", Optional filename As String = "", Optional pavd As String = "") As String
'https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=93149&TITLE_SEO=93149-kak-sdelat-otpravku-v-telegram-iz-makrosa-vba-excel&MID=1193376#message1193376
'pavd as photo animation audio voice video document
'4096 chars for message.text, 200 chars for message.caption
Const adTypeBinary = 1
Const adTypeText = 2
Const adModeReadWrite = 3
Const telegram = "https://api.telegram.org/bot"
Dim part As String
part = bond("--") & form("chat_id") & chat_id & bond()
Dim dfn As String
If Len(filename) Then dfn = Dir(filename)
Dim caption As String
Dim send As String
If Len(dfn) Then
caption = "caption"
Select Case LCase(pavd)
Case "photo", "animation", "audio", "voice", "video", "document"
send = LCase(pavd)
Case Else
dfnA = Split(LCase(dfn), ".")
Select Case dfnA(UBound(dfnA))
Case "jpg", "jpeg", "png"
send = "photo"
Case "gif", "apng"
send = "animation"
Case "mp4"
send = "video"
Case "mp3", "m4a"
send = "audio"
Case "ogg"
send = "voice"
Case Else
send = "document"
End Select
End Select
Else
caption = "text"
send = "message"
End If
part = part & form(caption) & text
Dim file
Dim body
With CreateObject("ADODB.Stream")
If Len(dfn) Then
' filename
part = part & bond() & form(send, dfn)
' read file as binary
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.LoadFromFile filename
.Position = 0
file = .Read
.Close
End If
' combine part, file , end
.Type = adTypeBinary
.Open
.Position = 0
.Write ToBytes(part)
'Debug.Print part
If Len(dfn) Then .Write file
.Write ToBytes(bond(suff:="--"))
.Position = 0
body = .Read
.Close
End With
With CreateObject("MSXML2.XMLHTTP")
'Debug.Print telegram & Token & "/send" & StrConv(send, vbProperCase)
.Open "POST", telegram & Token & "/send" & StrConv(send, vbProperCase), False
.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & bond("", "")
.send body
tmBotSend = .responseText
'Debug.Print .responseText
End With
End Function
Function ToBytes(str As String) As Variant
Const adTypeBinary = 1
Const adTypeText = 2
Const adModeReadWrite = 3
With CreateObject("ADODB.Stream")
.Mode = adModeReadWrite
.Type = adTypeText
.Charset = "UTF-8" '"_autodetect"
.Open
.WriteText str
.Position = 0
.Type = adTypeBinary
ToBytes = .Read
.Close
End With
End Function
Private Function bond(Optional pref As String = vbCrLf & "--", Optional suff As String = vbCrLf, Optional BOUNDARY As String = "--OYWFRYGNCYQAOCCT44655,4239930556") As String
bond = pref & BOUNDARY & suff
End Function
Private Function form(ByVal name As String, Optional ByVal filename As String = "") As String
form = "Content-Disposition: form-data; name=""" & name & """"
If Len(filename) Then form = form & "; filename=""" & filename & """"
form = form & vbCrLf & vbCrLf
End Function

VBA HTTP Request POST returning empty string

I am working on a procedure, in MS-Access VBA, to POST an XML text string to a web service and process the XML text string that is returned from the service.
The issue I am having is that the responseText property is always empty when it should contain a XML text string. No errors are returned and the .status = "OK".
I have tried the WinHttp.WinHttpRequest, MSXML2.XMLHTTP, and MSXML2.ServerXMLHTTP objects and consistently have the same issue.
Here is a code example:
Public Function Send() As Boolean
Dim oXHR As MSXML2.XMLHTTP60
Dim sURL, sCred As String
Dim sRequest, sResult, sStatus, sHeader As String
Dim bRtn As Boolean
BuildReqXML
sRequest = Me.RequestXML_String
With orsValues
sURL = .Fields("WebServiceURL").Value
sCred = Base64Encode(Trim(.Fields("User").Value) & ":" & Trim(.Fields("Password").Value))
End With
Set oXHR = New MSXML2.XMLHTTP60
With oXHR
.Open "POST", sURL, False
.SetRequestHeader "Authorization", "Basic " & sCred & """"
.SetRequestHeader "User-Agent", "Mozilla/4.0"
.SetRequestHeader "Content-Type", "text/xml"
.Send sRequest
sStatus = .StatusText
sResult = .ResponseText
sHeader = .GetAllResponseHeaders
If sResult <> "" Then
If Contains(sResult, "<") Then ReadXML sResult, "Response"
Debug.Print sResult
Else
Debug.Print sHeader
Debug.Print sRequest
End If
End With
Set oXHR = Nothing
End Function
I have verified that the web service is working correctly by building a similar call in a HTML document, sending the XML string, and receiving the response XML string.
Can someone please help me fix my issue?
I found the problem, with help from Fiddler.
The line setting the authorization header
.SetRequestHeader "Authorization", "Basic " & sCred & """"
Was adding a (") to the header line. The corrected line is
.SetRequestHeader "Authorization", "Basic " & sCred
Thank you for your help

Referencing a Cell .send Syntax Error // Web Scraping

Background/objective: Web Scrape: Problem with the Syntax using the .send
I am attempting to send the last name and first name from a list of names in two columns of cells, I am coming across Syntax Errors as it does not recognize the cell and assumes the range is the "name"
code:
The syntax error begins on the "last" and "first" line under the .send, as I am attempting to send a cell value rather than type in the name. What is the correct formatting when referencing a range of cells?
Option Explicit
Sub Test()
Dim sContent As String
Dim i As Long
Dim j As Long
Dim aHeader() As String
Dim aRows() As String
' Retrieve HTML content via XHR
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://npinumberlookup.org/getResults.php", False
.setRequestHeader "content-type", "application/x-www-form-urlencoded"
.send _
"last=Range(G:1)" & _
"&first=Range(F:1)" & _
"&pracstate=TX" & _
"&npi=" & _
"&submit=Search"
When you want to reference the value of a Range, is exactly as #Qharr said before. I tried doing:
' Retrieve HTML content via XHR
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://npinumberlookup.org/getResults.php", False
.setRequestHeader "content-type", "application/x-www-form-urlencoded"
.send _
"last=" & Range("G1").Value & _
"&first=" & Range("F1").Value & _
"&pracstate=TX" & _
"&npi=" & _
"&submit=Search"
End With
And it worked. No errors when running the code.

Convert Html String into HTMLDocument VBA

I'm writing a macro to grab the current exchange rate from yahoo but I'm having trouble converting a html string into a HTMLDocument to allow me to search for the required element by id. Here is my code so far but it fails on the debug.print line.
Public Sub Forex(currency1 As String, currency2 As String)
Dim oXHTTP As Object
Dim doc As HTMLDocument
Dim url As String
Dim html As String
Dim id As String
Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
url = "http://finance.yahoo.com/q?s=" & currency1 & currency2 & "=X"
oXHTTP.Open "GET", url, False
oXHTTP.send
html = oXHTTP.responseText
Set oXHTTP = Nothing
Set doc = New HTMLDocument
doc.body.innerHTML = html
id = "yfs_l10_" & currency1 & currency2
Debug.Print doc.getElementById("id").innerText
End Sub
What am I missing here?
I am making use of method from excel-vba-http-request-download-data-from-yahoo-finance:
Sub Forex(currency1 As String, currency2 As String)
Dim url As String, html As String, id As String
Dim oResult As Variant, oLine As Variant, sRate As String
url = "http://finance.yahoo.com/q?s=" & currency1 & currency2 & "=X"
id = "<span id=""yfs_l10_" & currency1 & currency2 & "=x"">"
html = GetHTTPResult(url)
oResult = Split(html, vbLf)
For Each oLine In oResult
If InStr(1, oLine, id, vbTextCompare) Then
sRate = Split(Split(oLine, "<span id=""yfs_l10_audusd=x"">")(1), "</span>")(0)
Exit For
End If
Next
End Sub
Function GetHTTPResult(sURL As String) As String
Dim XMLHTTP As Variant, sResult As String
Set XMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
XMLHTTP.Open "GET", sURL, False
XMLHTTP.send
sResult = XMLHTTP.responseText
Set XMLHTTP = Nothing
GetHTTPResult = sResult
End Function
You're almost there, you just have the id wrong:
id = "yfs_l10_" & currency1 & currency2 & "=X"
Debug.Print doc.getElementById(id).innerText