Question

背景

我需要抓取数据，因为我无法直接访问源数据。这是我公司内部批准的活动。

我不允许发布HTML的任何部分;但是，因为我已经验证了代码的抓取部分，所以不应该这样做。

我写了一个VBA宏：

打开Internet Explorer窗口
导航到Intranet网站
在一个工作表中加载一个提交单元格内容的网站
进入客户记录的流程
查找特定网站对象ID
将特定ID中的值保存到同一工作簿中的第二个工作表
释放记忆
退出

问题：

数据不会保存到工作表中。

我尝试过的事情：

创建新的输出工作表
使用现有输出工作表
在工作簿上使用“保存”，“激活”和“选择”命令
通过以下方式引用工作表：
- 代码名称
- 工作表名称
- 索引
详尽的试验和错误以及等量的研究

守则：

Option Explicit

Sub GetxyzData()

Dim rowCount As Integer
Dim colCount As Integer
Dim objIE As InternetExplorer
Dim ele As Object
Dim startRange As Range
Dim NoteFound As Boolean
Dim ContactFound As Boolean
Dim itm As Object

'Create the IE Object
Set objIE = CreateObject("InternetExplorer.Application")

'Set the position and size attributes of the IE Object
objIE.Top = 0
objIE.Left = 0
objIE.Width = 800
objIE.Height = 600

'Set the visibility of the IE Object
objIE.Visible = True

'Check to see if there was an error with the website
On Error Resume Next
objIE.navigate ("http://xyz/xyz_Individual/Applications/xyz/SearchMain.aspx/")

'Wait until the website is ready to begin along with error checking
Do While objIE.Busy
   DoEvents

   'Check to see if there was an error loading the website
   If Err.Number <> 0 Then
      objIE.Quit
      Set objIE = Nothing
      GoTo Program_Exit
   End If

   'Wait until the website is ready to begin
   Application.StatusBar = "Connecting to Website..."
   DoEvents
Loop

'Set the Row Number to 1 since there is a header row
rowCount = 1

'Set the data entry into Excel in the First Column and row
startRange = "A1"

'Continue to loop through the Excel data until a blank entry is found in the ID Number column
Do While Sheet5.Range("K" & rowCount) <> ""

   'Populate the Prospect ID Number in the search box with value in cell "K + Counter"
   objIE.document.getElementById("ctl00$txtProspectid").innerText = _
         "0" & Sheet5.Range("K" & rowCount).Value

   'Click the search button
   objIE.document.getElementById("ctl00_btnsearch").Click

   'Wait until the website is ready to begin along with error checking
   Do While objIE.Busy
      Application.StatusBar = "Downloading information, Please wait..."
      DoEvents
   Loop

   'Check to see if this is the first customer and click the appropriate Prospect hyperlink
   If rowCount = 1 Then
      objIE.document.getElementById("ctl00_GrdExtract_ctl03_btnsel").Click
   Else
      objIE.document.getElementById("ctl00_GrdMember_ctl03_lnkProspectID").Click
   End If

   'Wait until the website is ready to begin
   Do While objIE.Busy
      Application.StatusBar = "Downloading information, Please wait..."
      DoEvents
   Loop

'Set table type indicators to know when we are processing the 1st data field in each
   NoteFound = False
   ContactFound = False

'Get the data fields for PII, Contacts and Notes based on the common portion of ID name
   With Sheets("MWData")
      For Each itm In objIE.document.all
         'If it is not a PII, Contact or Note field, then skip it
         If itm.ID Like "*ctl00_CPH1_tabcontbottom_tabpnlContact_grdContact*" Or _
            itm.ID Like "*ctl00_CPH1_tabcontbottom_tabpnlNotes_GrdUserNotes*" Or _
            itm.ID Like "*ctl00_CPH1_tabconttop_TabpnlPI_txt*" Then

            'Write itm.Value to screen if it is not blank
            If itm.Value <> "" Then
               MsgBox itm.Value
            End If

            ' Check to see if it is the first Contact field for the customer, if so save the
            ' column number the last contact field holds and then increment the rowCounter to store
            ' the first field of the Note fields.
            If itm.ID Like "*ctl00_CPH1_tabcontbottom_tabpnlContact_grdContact*" Then
               'If this is the first Contact field then we want to save the the current colCount
               If ContactFound = False Then
                  .Range(colCount & rowCount) = "ContactStart = " & colCount
                  colCount = rowCount + 1
                  ContactFound = True
               End If
            End If
            ' Check to see if it is the first Note field for the customer, if so save the
            ' column number the last note field holds
            If itm.ID Like "*ctl00_CPH1_tabcontbottom_tabpnlNotes_GrdUserNotes*" Then
               'If this is the first Note field then we want to save the the current colCount
               If NoteFound = False Then
                  .Range(colCount & rowCount) = "NoteStart = " & colCount
                  colCount = rowCount + 1
                  NoteFound = True
               End If
            End If

            ' Store the fields value in the next available column on the same row
            Sheets("MWData").Range(colCount & rowCount) = itm.Value
            'Increment the column counter to the next to prepare to write the next field
            colCount = colCount + 1

         End If

      Next itm
   End With

'Increment the row counter and set the column counter back to 1
rowCount = rowCount + 1
colCount = 1

'Loop back to get the next customer entry
Loop

Application.StatusBar = "Download Complete....."

'Exit the program if there was an error retrieving the website
Program_Exit:

'Clean up system resources before ending the program
objIE.Quit
Set objIE = Nothing

End Sub

Answer 1

您在代码中多次使用此#include<queue> #include<iostream> template<class T, class C = vector<T>, class P = less<typename C::value_type> > struct MyPriorityQueue : std::priority_queue<T,C,P> { typename C::iterator begin() { return std::priority_queue<T, C, P>::c.begin(); } typename C::iterator end() { return std::priority_queue<T, C, P>::c.end(); } }; int main() { MyPriorityQueue<int> pq; pq.push(0); pq.push(1); for (auto &v : pq) { std::cout << v << std::endl; } }：

.Range(colCount & rowCount)

.Range(colCount & rowCount) = "ContactStart = " & colCount

.Range(colCount & rowCount) = "NoteStart = " & colCount

但是Sheets("MWData").Range(colCount & rowCount) = itm.Value和colCount是整数，所以这不会起作用，例如您将rowCount Range(12)和colCount = 1。

您可以使用rowCount = 2这样的Cells集合，但不能使用Worksheet对象，例如

Range

将数据保存到工作表

1 个答案: