1

私の質問は比較的単純で、非常に回避的です。インターネットや StackOverflow で見つけた多くの質問と同じですが、私の小さな難問を解決する提案はありません....

Excel2010を使用して、単一のフィールドにデータを入力して送信し（パート1）、数行のデータをキャプチャし（パート2）、リスト/テーブル形式でExcelに貼り付け（パート30 - そしてそれを999,999回行う.....パート 1 と 3 は機能しています - パート 2 は新しいインターネット ウィンドウを認識することを拒否し、すべての gettagnames と SelectTable の回避策は元の URL を使用するだけです - 添付されたものは Sendkeys を使用した必死の試みでした - さらに悪いことに! - 最初のループでは - その後はまったく何もありません!

とにかく、コードはかなり単純なはずです - コーディング順序のいくつかの混乱をお詫びします - それは私がメスでビットを切り取り始めたのですが、何時間もいじった後、手斧に頼りました...

Dim HTMLdoc As HTMLDocument
Dim ie As InternetExplorer

Sub EPF_FSA()

'Application.DisplayAlerts = False
Application.EnableEvents = False

Dim iHTML_Element As IHTMLElement
Dim sURL As String
Dim miss1 As Integer
Dim FrmNo As Long
Dim FrmName As String
Dim Address1 As String
Dim Address2 As String
Dim Address3 As String
Dim Address4 As String
Dim Address5 As String
Dim Address6 As String
Dim Address7 As String
Dim Address8 As String
Dim AnyLuck As String
Dim RowNum As Integer
Dim ColNum As Integer

RowNum = 1
ColNum = 1


FrmNo = 100111

While FrmNo <= 100112
'Do While FrmNo <= 100112
On Error GoTo Err_Clear
sURL = "http://www.fsa.gov.uk/register/epfSearchForm.do"


Set ie = CreateObject("internetexplorer.application")
'Set Ex = CreateObject("MicrosoftExcel.application")
ie.navigate sURL
ie.Visible = True

Do
' Wait till the Browser is loaded
Loop Until ie.readyState = READYSTATE_COMPLETE

Set HTMLdoc = ie.document

HTMLdoc.all.epfref.Value = FrmNo

For Each iHTML_Element In HTMLdoc.getElementsByTagName("input")

If iHTML_Element.Type = "submit" Then miss1 = miss1 + 1
If miss1 = 2 Then iHTML_Element.Click: Exit For
Next

Err_Clear:
If Err <> 0 Then Err.Clear
Resume Next
'PART 2 ********************************************************************
Do
' Wait till the Browser is loaded
Loop Until ie.readyState = READYSTATE_COMPLETE

Call SendKeys("^a")
DoEvents
Call SendKeys("^c")
DoEvents

      ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False
        range("A2").Select

'Copy and select relevant text to sheet 2

  Worksheets("Sheet1").Activate
 FrmName = Cells(39, "A").Value

 Address1 = Cells(59, "A").Value
 Address2 = Cells(60, "A").Value
 Address3 = Cells(61, "A").Value
 Address4 = Cells(62, "A").Value
 Address5 = Cells(63, "A").Value
 Address6 = Cells(64, "A").Value
 Address7 = Cells(65, "A").Value
 Address8 = Cells(66, "A").Value
 AnyLuck = Cells(47, "A").Value


  Worksheets("Sheet2").Activate
 Cells(RowNum, "A").Value = FrmNo
 Cells(RowNum, "B").Value = FrmName
 Cells(RowNum, "C").Value = Address1
 Cells(RowNum, "D").Value = Address2
 Cells(RowNum, "E").Value = Address3
 Cells(RowNum, "F").Value = Address4
 Cells(RowNum, "G").Value = Address5
 Cells(RowNum, "H").Value = Address6
 Cells(RowNum, "I").Value = Address7
 Cells(RowNum, "J").Value = Address8
 Cells(RowNum, "K").Value = AnyLuck
   RowNum = RowNum + 1
'ActiveCell.Offset(1, 0).Select
  Worksheets("Sheet1").Activate
    Cells.Select
    Selection.Delete Shift:=xlUp
    range("A2").Select
'MsgBox (FrmNo & Chr(10) & FrmName)
'Part 3
FrmNo = FrmNo + 1
ie.Quit
ie.Quit
Wend
'Loop

Application.EnableEvents = True

End Sub
4

1 に答える 1

0

結果ページに直接アクセスできるようです。試す：

sUrl = "http://www.fsa.gov.uk/register/epfRefSearch.do?epfRef="
sUrl = sUrl & frmNo

次に、そのページに移動します。実際の詳細は、「ボックス」の ID を持つ div にあります。

于 2013-04-04T08:36:34.887 に答える