Question

我正在构建一个模型，尝试使用Select All＆gt;从不同网站上的网络中提取数据。复制。下面是我的代码，它似乎在某些区域中以中断模式工作，而在其他区域中它只在我运行宏时才起作用。

当时困扰我的部分是它点击时：“ActiveSheet.PasteSpecial Format：=”Text“，link：= False，DisplayAsIcon：= False”，它失败并给我错误1004“PasteSpecial方法工作表类失败。“

在调试后点击F8，代码继续正常（虽然在显示“无法在中断模式下执行代码3次）。我已经尝试更改代码以显示”工作表（“GOOGLE”）“和其他直接定义工作表的方法。我的预感可能不是问题。如果是这样的话，我不知道这里发生了什么！有人可以测试一下吗？

仅供参考我还在此代码之上使用Userform（无模式）作为“等待”消息，因为它可能需要很长时间才能运行。不确定这是否会干扰粘贴。

Dim IE As Object
Dim PauseTime, Start
PauseTime = 22 ' Set duration in seconds
Start = Timer ' Set start time.

Application.ScreenUpdating = False

Worksheets("GOOGLE").Activate
Worksheets("GOOGLE").Cells.Clear
Worksheets("GOOGLE").Range("A1").Copy
Application.CutCopyMode = False


    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Navigate Range("GOOGLEURL").Value
        Do Until .ReadyState = 4: DoEvents: Loop
        End With

        Do While Timer < Start + PauseTime
        DoEvents
        Loop

        IE.ExecWB 17, 0 '// SelectAll
        IE.ExecWB 12, 2 '// Copy selection
        ActiveSheet.Range("A1").Select
        ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False
        IE.Quit


    On Error GoTo Ending
        IE.Quit 
        Application.CutCopyMode = False

Ending:
Application.CutCopyMode = False
Exit Sub

Answer 1

尝试此方法，而不是在应用程序之间复制/粘贴。和你一样，我试过这个，发现它不可靠，常常没用。

您可以在字符串中抓取页面innerText并使用它，或者，您可以将innerText拆分为数组并将其放在工作表上，就像我在示例中所做的那样。这样可以保留换行符并使其比将所有文本放在单个单元格中更具可读性

我在一个简单的例子（http://google.com）上验证了这一点，两个方法都返回了工作表中完全相同的单元格布局。

注意：当您在IE中安装ChromeFrameBHO加载项时，此方法可能无效（请参阅here）。

Sub Test()
Dim IE As Object
Dim pageText As String
Dim page As Variant

Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Navigate "http://google.com"
        Do Until .ReadyState = 4: DoEvents: Loop
    End With

    pageText = IE.Document.body.innertext
    page = Split(pageText, vbCr)

    Range("A1").Resize(UBound(page)).Value = Application.Transpose(page)

    IE.Quit
    Set IE = Nothing

End Sub

另一种不依赖Internet Explorer的方法是QueryTables方法。它可能适合您的需求，也可能不适合您，但请尝试这样的事情。

注意：此方法似乎适用于（对我来说）ChromeFrameBHO插件是否已安装。

Sub TestQueryTables()

    Dim googleURL as String
    googleURL = Range("GOOGLEURL")

    With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;" & googleURL _
            , Destination:=Range("A1"))
            .Name = googleURL
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = True
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone 'or use xlWebFormattingAll to preserve formats
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With

End Sub

Answer 2

我实际上一直在努力解决这个完全相同的问题，从复制和粘贴一堆图像。 Excel 2010显然在复制命令完成之前尝试粘贴存在问题。您可以做的是睡眠事件和处理特定1004错误的错误的组合。设置错误处理程序以捕获1004错误，并让它恢复。我做的是建立一个这样的计数器：

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
On Error GoTo ErrorHandler:
Dim err_counter As Integer

ErrorHandler:

If Err.Number = 1004 Then
    err_counter = err_counter + 1

    If err_counter > 10 Then
        MsgBox ("The copy function is taking too long. Consider using smaller images.")
        Exit Sub
    End If

    DoEvents
    Sleep 500
    DoEvents
ElseIf Err.Number <> 0 Then
    MsgBox ("Unknown error.")
    On Error GoTo 0
    Resume
End If

您不需要使用错误计数器，但我认为保持我的电子表格的未来用户以某种方式创建无限循环是个好主意。我也会在每次图像粘贴后清除剪贴板，如果使用错误计数器，请在粘贴成功后将其重置为0.

Answer 3

看起来你正在复制，但是在粘贴之前你正在清理剪贴板，所以没有任何代码可以粘贴。

Worksheets("GOOGLE").Range("A1").Copy
Application.CutCopyMode = False

另外，你是从Sheets（“Google”）。范围（“A1”）复制到Sheets（“Google”）。范围（“A1”）？我不明白

Answer 4

我无法核实我的回复，但一年前我遇到了类似的问题。有问题的网页必须使用复制/粘贴而不是使用innertext。看来你已经完成了我所做的大部分工作，包括暂停等待或复制完成。（Readystate对我没有帮助。）

我记得做的最后一件事，即允许代码工作，就是将粘贴放在一个有限的循环中。在第三次和第八次尝试之间，粘贴通常是成功的。

我确信有更好的方法，但无法找到它。由于我的应用程序是我自己使用的代码是可以接受的。由于网页每隔几个月就会发生变化，因此代码被放弃了。

Excel2010：从IE复制时PasteSpecial失败

4 个答案: