I have this code working perfectly on my Microsoft Excel, but I need to adapt it so it works on Mac since some people on the team use Excel for Mac. is there a way to adapt the setobject, or the macro needs to be rewritten.?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("B6:B100")) Is Nothing Then
If Target.Count > 1 Then Exit Sub 'If users selects more than one cell, exit sub to prevent bugs
If Target.Value = vbNullString Then Exit Sub
Dim AccToken As String
AccToken = Sheet1.Range("C4").Value
If AccToken = vbNullString Then
MsgBox "Please enter your Bitly Access Token to get started" & vbCrLf & "hoi"
Exit Sub
End If
Dim LongURL As String
LongURL = Target.Value
Dim objHTTP As Object
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
Dim URL As String
URL = "https://api-ssl.bitly.com/v4/bitlinks"
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "Authorization", "Bearer " & AccToken
objHTTP.setRequestHeader "Content-type", "application/json"
Dim Json As String
Json = "{""long_url"": """ & LongURL & """, ""domain"": ""bit.ly"", ""group_guid"": ""account_group_guid""}" 'the group_guid for free bitly accounts is on the url https://app.bitly.com/{group_guid}/bitlinks/
objHTTP.send Json
Dim result As String
result = objHTTP.responseText
Me.Range("C" & Target.Row).Value = Left(result, Len(result) - 1)
Set objHTTP = Nothing
End If
End Sub