运行在Access宏它采取从互联网上的信息，并在字段中输入他们

Question

现状：

Excel工作表：我做了VBA代码，其经过一列的每个单元，采取DHL跟踪号内，在DHL网站上搜索关于这一个的更多信息，然后在2个分隔的栏目中输出重要信息（上一次更新的状态和日期）。这部分是好的，可以工作，但现在我试图在Access窗体上应用这个完全相同的过程。

问题：

访问：我试图找到一种方法去通过表单的特定字段的每个记录，复制它包含的信息，然后做互联网的一部分，如上所述，并写入同样形式的2个其他领域的2个重要信息。

问题是，我没有设法首先查看表单特定字段的每个记录。

有什么建议吗？

如果您需要更多信息或者不清楚，请告诉我。

编辑：My form绑定到表。我在上面谈论一个表单，但是找到一个可以应用在Access表上的解决方案也是完全正确的。这是一个包含多个记录的数据表格。我第一次创建表格的原因是为大多数字段设置了许多复杂的验证规则，并且也为了一些更新查询的目的。

为了您的信息VBA代码如下：

Sub Main() 

Dim AWB_Number As Double 
Dim internet As Object 
Dim path As String 
Dim IEDoc As HTMLDocument 
Dim objShell As Object 
Dim IE_count As Integer 
Dim La_Date As String 
Dim Le_Texte As String 
Dim i As Integer 

Columns("V").NumberFormat = "General" 
For i = 4 To Range("Q" & Rows.Count).End(xlUp).Row ' A CHANGER !!! 
'MsgBox TypeName(Range("Q" & i).Value) 

    If TypeName(Range("Q" & i).Value) = "Double" And Range("Q" & i).Value <> 0 Then 
    AWB_Number = Range("Q" & i).Value 
    Else: GoTo Laa 
    End If 
    'Cells(13, 3).Value = 0 
    'Cells(14, 3).Value = 0 
    'Cells(15, 3).Value = 0 
    'New InternetExplorer 
     path = "http://www.dhl.co.uk/en/express/tracking.html" 

     Set internet = CreateObject("InternetExplorer.Application") 
     internet.Visible = True 
     internet.navigate path 
     Do While internet.readyState <> 4 
     Loop 
     Set IEDoc = internet.document 

     'MsgBox IEDoc.getElementsByName("AWB").Length' 1 
     IEDoc.getElementsByName("AWB")(0).Value = AWB_Number 

     'MsgBox IEDoc.getElementsByClassName("tracking-button").Length' 1 
     IEDoc.getElementsByClassName("tracking-button")(0).Click 

     Do While internet.readyState <> 4 
     Loop 
     Set IEDoc = internet.document 

    Application.Wait Now + TimeSerial(0, 0, 1.5) 'Call Warte_mal 
    'On Error GoTo Ici 
     'MsgBox IEDoc.getElementsByClassName("result-checkpoints show result-has-pieces").Length '1 
     'MsgBox IEDoc.getElementsByClassName("result-checkpoints show result-has-pieces")(0).getElementsByTagName("th")(0).innerText ' Thursday, October 20, 2016 
     On Error Resume Next 
     'If IEDoc.getElementsByClassName("result-checkpoints show result-has-pieces")(0).getElementsByTagName("th")(0).innerText Is Nothing Then 
     'GoTo Ici 
     La_Date = IEDoc.getElementsByClassName("result-checkpoints show result-has-pieces")(0).getElementsByTagName("th")(0).innerText 
    'End If 
     Le_Texte = IEDoc.getElementsByClassName("result-checkpoints show result-has-pieces")(0).getElementsByTagName("td")(1).innerText 
     Range("R" & i).Value = La_Date & " " & Le_Texte 
     La_Date = "" 
     Le_Texte = "" 

     Call Filtre(Range("R" & i).Value, i) 
Ici: 
      internet.Quit 
    Set internet = Nothing 
Laa: 
Next i 

'Range("R:R").EntireColumn.Delete 
Range("T:T").EntireColumn.AutoFit 
Range("V:V").EntireColumn.AutoFit 
MsgBox "Congratulations Dragos, you've officially been replaced !" 

End Sub 

Answer 1

范围不是内部访问的范围。您需要打开数据集并遍历每条记录。所以，像这样：

Dim db as Database 
Dim rec as Recordset 

Set db = CurrentDB 
Set rec = db.OpenRecordset("SELECT MyField FROM MyTable") 

Do while rec.EOF = false 
    'Use the Nz() function to check to see if there is a value 
    If Nz(rec(0), 0) <> 0 Then 
    AWB_Number = rec(0) 
    'Do whatever else you do with this number. Send it to DHL website 
    Else 
    End if 
    rec.MoveNext 
Loop 

rec.close 
db.close 

这是“aircode”;未经测试并具有通用信息。将“MyField”更改为表格中的字段名称等等。它可能需要一些调整，但它可能非常接近您的需要。