使用 VBA 打开 Chrome 并填写表格
Posted
技术标签:
【中文标题】使用 VBA 打开 Chrome 并填写表格【英文标题】：Using VBA to open Chrome and fill out a form 【发布时间】：2018-08-17 01:51:01 【问题描述】：我经常使用下面的网站来跟踪往返飞行里程。最近，该网站停止在 IE 中运行，所以我的代码也一样。由于我在工作计算机上使用它，因此我无法下载我在搜索中找到的许多其他解决方案，并且我无法使用另一个网站，除非经过漫长的过程来获得该网站的批准。有没有办法在 Chrome 中执行相同的任务而无需任何其他下载？
Dim ele As Object
Dim IE As New InternetExplorer
IE.Visible = True
IE.navigate "http://www.distancefromto.net"
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
'step 1
With IE
.document.getElementsByName("distance")(0).Value = Range("B2").Value
.document.getElementsByName("distance")(1).Value = Range("B3").Value & Range("E3").Value
.document.getElementById("hae").Click
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Application.Wait (Now + TimeValue("0:00:02"))
Dim a As String
a = Trim(.document.getElementById("totaldistancemiles").Value)
Dim aa As Variant
aa = Split(a, " ")
Range("C2").Value = aa(0)
'step 2
.document.getElementsByName("distance")(0).Value = Range("B4").Value & Range("E4").Value
.document.getElementById("hae").Click
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Application.Wait (Now + TimeValue("0:00:02"))
Dim b As String
b = Trim(.document.getElementById("totaldistancemiles").Value)
Dim bb As Variant
bb = Split(b, " ")
Range("C3").Value = bb(0)
'step 3
.document.getElementsByName("distance")(1).Value = Range("B2").Value
.document.getElementById("hae").Click
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Application.Wait (Now + TimeValue("0:00:02"))
Dim c As String
c = Trim(.document.getElementById("totaldistancemiles").Value)
Dim cc As Variant
cc = Split(c, " ")
Range("C4").Value = cc(0)
End With
IE.Quit
任何帮助，甚至是明确的“不，这不可能”都会非常感谢
谢谢
【问题讨论】：
【参考方案1】：铬：
使用 Chrome - 不。您需要下载 selenium basic 或使用不同的编程语言，例如 python。
不同的网站：
您可以切换到使用其他网站（请注意，由于网站的原因，您之前的数据可能存在一些细微差异，但从技术上讲，距离不应该有太大变化！）。我注意到你说这会有问题。冒着听起来像跟踪的风险，您以前使用过freemaptools，所以这可能是一个可以接受的选择？
API：
如果您找到提供 API 服务的网站，您可能可以放弃上述所有内容并发出XMLHTTP request。我看不到您的网站提供 API 服务，否则这显然是下一个选择。 @RahulChalwa 提到“[OP 正在使用的网站本身就是使用 google maps API 的包装器：https://maps.googleapis.com/maps/api/js/GeocodeService.Search。用户可以注册 API 并执行 POST 请求]”；所以这可能是前进的方向。主要文档here.
例如API站点：个人和小规模使用API - wheretocredit.com
当前设置调试：
确定 IE 在您当前的设置中不再工作的原因也是可取的，可能通过联系网站开发人员并提出您的问题。
使用Vincenty's formula 执行计算（如网站所做的那样），或者像其他网站那样使用Haversine 公式：
Haversine：
VBA haversine formula
Vicenty 的（包括示例代码）：
How to Calculate Distance in Excel
来自Contextures 的 Vicenty 代码。我已经归因，但如果不应该包括在此处，我将删除。
'*************************************************************
Private Const PI = 3.14159265358979
Private Const EPSILON As Double = 0.000000000001
Public Function distVincenty(ByVal lat1 As Double, ByVal lon1 As Double, _
ByVal lat2 As Double, ByVal lon2 As Double) As Double
'INPUTS: Latitude and Longitude of initial and
' destination points in decimal format.
'OUTPUT: Distance between the two points in Meters.
'
'======================================
' Calculate geodesic distance (in m) between two points specified by
' latitude/longitude (in numeric [decimal] degrees)
' using Vincenty inverse formula for ellipsoids
'======================================
' Code has been ported by lost_species from www.aliencoffee.co.uk to VBA
' from javascript published at:
' https://www.movable-type.co.uk/scripts/latlong-vincenty.html
' * from: Vincenty inverse formula - T Vincenty, "Direct and Inverse Solutions
' * of Geodesics on the Ellipsoid with application
' * of nested equations", Survey Review, vol XXII no 176, 1975
' * https://www.ngs.noaa.gov/PUBS_LIB/inverse.pdf
'Additional Reference: https://en.wikipedia.org/wiki/Vincenty%27s_formulae
'======================================
' Copyright lost_species 2008 LGPL
' https://www.fsf.org/licensing/licenses/lgpl.html
'======================================
' Code modifications to prevent "Formula Too Complex" errors
' in Excel (2010) VBA implementation
' provided by Jerry Latham, Microsoft MVP Excel Group, 2005-2011
' July 23 2011
'======================================
Dim low_a As Double
Dim low_b As Double
Dim f As Double
Dim L As Double
Dim U1 As Double
Dim U2 As Double
Dim sinU1 As Double
Dim sinU2 As Double
Dim cosU1 As Double
Dim cosU2 As Double
Dim lambda As Double
Dim lambdaP As Double
Dim iterLimit As Integer
Dim sinLambda As Double
Dim cosLambda As Double
Dim sinSigma As Double
Dim cosSigma As Double
Dim sigma As Double
Dim sinAlpha As Double
Dim cosSqAlpha As Double
Dim cos2SigmaM As Double
Dim C As Double
Dim uSq As Double
Dim upper_A As Double
Dim upper_B As Double
Dim deltaSigma As Double
Dim s As Double ' final result, will be returned rounded to 3 decimals (mm).
'added by JLatham to break up "Too Complex" formulas
'into pieces to properly calculate those formulas as noted below
'and to prevent overflow errors when using
'Excel 2010 x64 on Windows 7 x64 systems
Dim P1 As Double ' used to calculate a portion of a complex formula
Dim P2 As Double ' used to calculate a portion of a complex formula
Dim P3 As Double ' used to calculate a portion of a complex formula
'See https://en.wikipedia.org/wiki/World_Geodetic_System
'for information on various Ellipsoid parameters for other standards.
'low_a and low_b in meters
' === GRS-80 ===
' low_a = 6378137
' low_b = 6356752.314245
' f = 1 / 298.257223563
'
' === Airy 1830 === Reported best accuracy for England and Northern Europe.
' low_a = 6377563.396
' low_b = 6356256.910
' f = 1 / 299.3249646
'
' === International 1924 ===
' low_a = 6378388
' low_b = 6356911.946
' f = 1 / 297
'
' === Clarke Model 1880 ===
' low_a = 6378249.145
' low_b = 6356514.86955
' f = 1 / 293.465
'
' === GRS-67 ===
' low_a = 6378160
' low_b = 6356774.719
' f = 1 / 298.247167
'=== WGS-84 Ellipsoid Parameters ===
low_a = 6378137 ' +/- 2m
low_b = 6356752.3142
f = 1 / 298.257223563
'====================================
L = toRad(lon2 - lon1)
U1 = Atn((1 - f) * Tan(toRad(lat1)))
U2 = Atn((1 - f) * Tan(toRad(lat2)))
sinU1 = Sin(U1)
cosU1 = Cos(U1)
sinU2 = Sin(U2)
cosU2 = Cos(U2)
lambda = L
lambdaP = 2 * PI
iterLimit = 100 ' can be set as low as 20 if desired.
While (Abs(lambda - lambdaP) > EPSILON) And (iterLimit > 0)
iterLimit = iterLimit - 1
sinLambda = Sin(lambda)
cosLambda = Cos(lambda)
sinSigma = Sqr(((cosU2 * sinLambda) ^ 2) + _
((cosU1 * sinU2 - sinU1 * cosU2 * cosLambda) ^ 2))
If sinSigma = 0 Then
distVincenty = 0 'co-incident points
Exit Function
End If
cosSigma = sinU1 * sinU2 + cosU1 * cosU2 * cosLambda
sigma = Atan2(cosSigma, sinSigma)
sinAlpha = cosU1 * cosU2 * sinLambda / sinSigma
cosSqAlpha = 1 - sinAlpha * sinAlpha
If cosSqAlpha = 0 Then 'check for a divide by zero
cos2SigmaM = 0 '2 points on the equator
Else
cos2SigmaM = cosSigma - 2 * sinU1 * sinU2 / cosSqAlpha
End If
C = f / 16 * cosSqAlpha * (4 + f * (4 - 3 * cosSqAlpha))
lambdaP = lambda
'the original calculation is "Too Complex" for Excel VBA to deal with
'so it is broken into segments to calculate without that issue
'the original implementation to calculate lambda
'lambda = L + (1 - C) * f * sinAlpha * _
(sigma + C * sinSigma * (cos2SigmaM + C * cosSigma * _
(-1 + 2 * (cos2SigmaM ^ 2))))
'calculate portions
P1 = -1 + 2 * (cos2SigmaM ^ 2)
P2 = (sigma + C * sinSigma * (cos2SigmaM + C * cosSigma * P1))
'complete the calculation
lambda = L + (1 - C) * f * sinAlpha * P2
Wend
If iterLimit < 1 Then
MsgBox "iteration limit has been reached, something didn't work."
Exit Function
End If
uSq = cosSqAlpha * (low_a ^ 2 - low_b ^ 2) / (low_b ^ 2)
'the original calculation is "Too Complex" for Excel VBA to deal with
'so it is broken into segments to calculate without that issue
'the original implementation to calculate upper_A
'upper_A = 1 + uSq / 16384 * (4096 + uSq * _
(-768 + uSq * (320 - 175 * uSq)))
'calculate one piece of the equation
P1 = (4096 + uSq * (-768 + uSq * (320 - 175 * uSq)))
'complete the calculation
upper_A = 1 + uSq / 16384 * P1
'oddly enough, upper_B calculates without any issues - JLatham
upper_B = uSq / 1024 * (256 + uSq * (-128 + uSq * (74 - 47 * uSq)))
'the original calculation is "Too Complex" for Excel VBA to deal with
'so it is broken into segments to calculate without that issue
'the original implementation to calculate deltaSigma
'deltaSigma = upper_B * sinSigma * (cos2SigmaM + upper_B / 4 * _
(cosSigma * (-1 + 2 * cos2SigmaM ^ 2) _
- upper_B / 6 * cos2SigmaM * (-3 + 4 * sinSigma ^ 2) * _
(-3 + 4 * cos2SigmaM ^ 2)))
'calculate pieces of the deltaSigma formula
'broken into 3 pieces to prevent overflow error that may occur in
'Excel 2010 64-bit version.
P1 = (-3 + 4 * sinSigma ^ 2) * (-3 + 4 * cos2SigmaM ^ 2)
P2 = upper_B * sinSigma
P3 = (cos2SigmaM + upper_B / 4 * (cosSigma * (-1 + 2 * cos2SigmaM ^ 2) _
- upper_B / 6 * cos2SigmaM * P1))
'complete the deltaSigma calculation
deltaSigma = P2 * P3
'calculate the distance
s = low_b * upper_A * (sigma - deltaSigma)
'round distance to millimeters
distVincenty = Round(s, 3)
End Function
Function SignIt(Degree_Dec As String) As Double
'Input: a string representation of a lat or long in the
' format of 10° 27' 36" S/N or 10~ 27' 36" E/W
'OUTPUT: signed decimal value ready to convert to radians
'
Dim decimalValue As Double
Dim tempString As String
tempString = UCase(Trim(Degree_Dec))
decimalValue = Convert_Decimal(tempString)
If Right(tempString, 1) = "S" Or Right(tempString, 1) = "W" Then
decimalValue = decimalValue * -1
End If
SignIt = decimalValue
End Function
Function Convert_Degree(Decimal_Deg) As Variant
'source: https://support.microsoft.com/kb/213449
'
'converts a decimal degree representation to deg min sec
'as 10.46 returns 10° 27' 36"
'
Dim degrees As Variant
Dim minutes As Variant
Dim seconds As Variant
With Application
'Set degree to Integer of Argument Passed
degrees = Int(Decimal_Deg)
'Set minutes to 60 times the number to the right
'of the decimal for the variable Decimal_Deg
minutes = (Decimal_Deg - degrees) * 60
'Set seconds to 60 times the number to the right of the
'decimal for the variable Minute
seconds = Format(((minutes - Int(minutes)) * 60), "0")
'Returns the Result of degree conversion
'(for example, 10.46 = 10° 27' 36")
Convert_Degree = " " & degrees & "° " & Int(minutes) & "' " _
& seconds + Chr(34)
End With
End Function
Function Convert_Decimal(Degree_Deg As String) As Double
'source: https://support.microsoft.com/kb/213449
' Declare the variables to be double precision floating-point.
' Converts text angular entry to decimal equivalent, as:
' 10° 27' 36" returns 10.46
' alternative to ° is permitted: Use ~ instead, as:
' 10~ 27' 36" also returns 10.46
Dim degrees As Double
Dim minutes As Double
Dim seconds As Double
'
'modification by JLatham
'allow the user to use the ~ symbol instead of ° to denote degrees
'since ~ is available from the keyboard and ° has to be entered
'through [Alt] [0] [1] [7] [6] on the number pad.
Degree_Deg = Replace(Degree_Deg, "~", "°")
' Set degree to value before "°" of Argument Passed.
degrees = Val(Left(Degree_Deg, InStr(1, Degree_Deg, "°") - 1))
' Set minutes to the value between the "°" and the "'"
' of the text string for the variable Degree_Deg divided by
' 60. The Val function converts the text string to a number.
minutes = Val(Mid(Degree_Deg, InStr(1, Degree_Deg, "°") + 2, _
InStr(1, Degree_Deg, "'") - InStr(1, Degree_Deg, "°") - 2)) / 60
' Set seconds to the number to the right of "'" that is
' converted to a value and then divided by 3600.
seconds = Val(Mid(Degree_Deg, InStr(1, Degree_Deg, "'") + _
2, Len(Degree_Deg) - InStr(1, Degree_Deg, "'") - 2)) / 3600
Convert_Decimal = degrees + minutes + seconds
End Function
Private Function toRad(ByVal degrees As Double) As Double
toRad = degrees * (PI / 180)
End Function
Private Function Atan2(ByVal X As Double, ByVal Y As Double) As Double
' code nicked from:
' https://en.wikibooks.org/wiki/Programming:Visual_Basic_Classic
' /Simple_Arithmetic#Trigonometrical_Functions
' If you re-use this watch out: the x and y have been reversed from typical use.
If Y > 0 Then
If X >= Y Then
Atan2 = Atn(Y / X)
ElseIf X <= -Y Then
Atan2 = Atn(Y / X) + PI
Else
Atan2 = PI / 2 - Atn(X / Y)
End If
Else
If X >= -Y Then
Atan2 = Atn(Y / X)
ElseIf X <= Y Then
Atan2 = Atn(Y / X) - PI
Else
Atan2 = -Atn(X / Y) - PI / 2
End If
End If
End Function
'======================================
【讨论】：
原来 OP 使用的网站是谷歌地图 API 的包装器。https://maps.googleapis.com/maps/api/js/GeocodeService.Search。用户可以注册 API 并进行发布请求。
这很有帮助。我应该编辑它还是要发布一个单独的答案@RahulChawla？
您可以继续并将其添加到您的答案中。
页面在渲染完directions.js后做一个post请求。这给出了位置的纬度，然后计算测地距离。它在开发工具中。
这回答了你的问题吗？以上是关于使用 VBA 打开 Chrome 并填写表格的主要内容，如果未能解决你的问题，请参考以下文章