Downloads list of domains and prices for register, renew or transfer into active Excel sheet using your NameSilo API key.
Sub NameSilo_APICall_ListPrices()
'
Application.Calculation = xlCalculationManual
ActiveSheet.Range("J1", "O1").EntireColumn.ClearContents
ActiveSheet.Range("J5").Value = "ID"
ActiveSheet.Range("K5").Value = "Extension"
ActiveSheet.Range("L5").Value = "Register"
ActiveSheet.Range("M5").Value = "Renew"
ActiveSheet.Range("N5").Value = "Transfer"
ActiveSheet.Range("O5").Value = "My rank"
ActiveSheet.Range("K2").FormulaR1C1 = "=""Namesilo prices (""&counta(R5c:R50000c)-1&"")"""
'
MyKey = "your_api_key_with_namesilo"
URL1 = "https://www.namesilo.com/api/getPrices?version=1&type=xml&key=" & MyKey
RettString = Navigate(CStr(URL1), "")
If InStr(1, RettString, " <code >300 </code >", vbTextCompare) = 0 Then GoTo ByeBye_Err
Found1 = InStr(1, RettString, " </Detail >", vbTextCompare) + 2
Do
NextDom1 = InStr(Found1, RettString, " <", vbTextCompare)
If NextDom1 = 0 Then Exit Do
NextDom2 = InStr(NextDom1, RettString, " >", vbTextCompare)
If NextDom2 = 0 Then Exit Do
NextDom = Mid(RettString, NextDom1 + 1, NextDom2 - NextDom1 - 1)
If NextDom = "/reply" Then Exit Do
DomBlock = CutString(RettString, " <" & NextDom & " >", " </" & NextDom & " >")
DoEvents
NewRow = CountColumnCells("J", , ActiveSheet.Name)
ActiveSheet.Range("J5").Offset(NewRow, 0).Value = NewRow
ActiveSheet.Range("J5").Offset(NewRow, 1).Value = NextDom
ActiveSheet.Range("J5").Offset(NewRow, 2).Value = CutString(DomBlock, " <registration >", " </registration >")
ActiveSheet.Range("J5").Offset(NewRow, 3).Value = CutString(DomBlock, " <transfer >", " </transfer >")
ActiveSheet.Range("J5").Offset(NewRow, 4).Value = CutString(DomBlock, " <renew >", " </renew >")
Found2 = InStr(1, RettString, " </" & NextDom & " >", vbTextCompare) + 4
Found1 = Found2
Loop
ByeBye_Err:
MsgBox "Error!", vbCritical
ByeBye:
ActiveSheet.Range("J5", "J" & NewRow + 4).Offset(1, 5).FormulaR1C1 = "=100-((LEN(RC[-4])-2)*4)-(RC[-3]/10*2)"
Application.Calculation = xlCalculationAutomatic
End Sub
'
Application.Calculation = xlCalculationManual
ActiveSheet.Range("J1", "O1").EntireColumn.ClearContents
ActiveSheet.Range("J5").Value = "ID"
ActiveSheet.Range("K5").Value = "Extension"
ActiveSheet.Range("L5").Value = "Register"
ActiveSheet.Range("M5").Value = "Renew"
ActiveSheet.Range("N5").Value = "Transfer"
ActiveSheet.Range("O5").Value = "My rank"
ActiveSheet.Range("K2").FormulaR1C1 = "=""Namesilo prices (""&counta(R5c:R50000c)-1&"")"""
'
MyKey = "your_api_key_with_namesilo"
URL1 = "https://www.namesilo.com/api/getPrices?version=1&type=xml&key=" & MyKey
RettString = Navigate(CStr(URL1), "")
If InStr(1, RettString, " <code >300 </code >", vbTextCompare) = 0 Then GoTo ByeBye_Err
Found1 = InStr(1, RettString, " </Detail >", vbTextCompare) + 2
Do
NextDom1 = InStr(Found1, RettString, " <", vbTextCompare)
If NextDom1 = 0 Then Exit Do
NextDom2 = InStr(NextDom1, RettString, " >", vbTextCompare)
If NextDom2 = 0 Then Exit Do
NextDom = Mid(RettString, NextDom1 + 1, NextDom2 - NextDom1 - 1)
If NextDom = "/reply" Then Exit Do
DomBlock = CutString(RettString, " <" & NextDom & " >", " </" & NextDom & " >")
DoEvents
NewRow = CountColumnCells("J", , ActiveSheet.Name)
ActiveSheet.Range("J5").Offset(NewRow, 0).Value = NewRow
ActiveSheet.Range("J5").Offset(NewRow, 1).Value = NextDom
ActiveSheet.Range("J5").Offset(NewRow, 2).Value = CutString(DomBlock, " <registration >", " </registration >")
ActiveSheet.Range("J5").Offset(NewRow, 3).Value = CutString(DomBlock, " <transfer >", " </transfer >")
ActiveSheet.Range("J5").Offset(NewRow, 4).Value = CutString(DomBlock, " <renew >", " </renew >")
Found2 = InStr(1, RettString, " </" & NextDom & " >", vbTextCompare) + 4
Found1 = Found2
Loop
ByeBye_Err:
MsgBox "Error!", vbCritical
ByeBye:
ActiveSheet.Range("J5", "J" & NewRow + 4).Offset(1, 5).FormulaR1C1 = "=100-((LEN(RC[-4])-2)*4)-(RC[-3]/10*2)"
Application.Calculation = xlCalculationAutomatic
End Sub
Views 3,727
Downloads 1,297
CodeID
DB ID
ANmarAmdeen
608
Revisions
v1.0
Friday
May
25
2018