আমি এই অসাধারণ VBA স্ক্রিপ্টটি খুঁজে পেয়েছি যা একটি ঠিকানা নেয় এবং Google এর মানচিত্র API ব্যবহার করে অক্ষাংশ এবং দ্রাঘিমাংশটি ফেরত দেয়। যাইহোক, গুগল হার-সীমাবদ্ধ বৈশিষ্ট্য রয়েছে, এবং আমি এটি বড় সংখ্যক ঠিকানাগুলির জন্য করতে চাই (প্রায় 3 মিলিয়ন)। অন্যদিকে, স্ক্রিপ্টটি কোন হার-সীমাবদ্ধতা নেই, বরং তাদের সামঞ্জস্যপূর্ণ করে তোলে। এই স্ক্রিপ্টটি সম্পাদনা করা কি সম্ভব যে এটি পূর্ববর্তী অনুরোধটি শেষ না হওয়া পর্যন্ত পরবর্তী কক্ষে চলে না?
Function MyGeocode(address As String) As String
Dim strAddress As String
Dim strQuery As String
Dim strLatitude As String
Dim strLongitude As String
strAddress = URLEncode(address)
'Assemble the query string
strQuery = "http://maps.googleapis.com/maps/api/geocode/xml?"
strQuery = strQuery & "address=" & strAddress
strQuery = strQuery & "&sensor=false"
'define XML and HTTP components
Dim googleResult As New MSXML2.DOMDocument60
Dim googleService As New MSXML2.XMLHTTP60
Dim oNodes As MSXML2.IXMLDOMNodeList
Dim oNode As MSXML2.IXMLDOMNode
'create HTTP request to query URL - make sure to have
'that last "False" there for synchronous operation
googleService.Open "GET", strQuery, False
googleService.send
googleResult.LoadXML (googleService.responseText)
Set oNodes = googleResult.getElementsByTagName("geometry")
If oNodes.Length = 1 Then
For Each oNode In oNodes
strLatitude = oNode.ChildNodes(0).ChildNodes(0).Text
strLongitude = oNode.ChildNodes(0).ChildNodes(1).Text
MyGeocode = strLatitude & "," & strLongitude
Next oNode
Else
MyGeocode = "Not Found (try again, you may have done too many too fast)"
End If
End Function
Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
Dim StringLen As Long: StringLen = Len(StringVal)
If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String, Space As String
If SpaceAsPlus Then Space = "+" Else Space = "%20"
For i = 1 To StringLen
Char = Mid$(StringVal, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = Char
Case 32
result(i) = Space
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next i
URLEncode = Join(result, "")
End If
End Function
কোন সাহায্য ব্যাপকভাবে প্রশংসা করা হবে, আপনি বলছি সেরা!