Excel2010:从IE复制时，PasteSpecial失败 [英] Excel2010: PasteSpecial failing when copying from IE

问题描述

我正在构建一个模型，该模型尝试使用全选">复制"从不同网站上的Web提取数据.下面是我所拥有的代码，它似乎在某些区域以中断模式工作，而在其他区域，只有在运行宏时它才能工作.

I'm building a model that attempts to pull data from the web across different websites using Select All > Copy. Below is the code that I have, and it seems to work in break mode in certain areas, and in other areas it only works when I run the macro.

当时让我感到困惑的部分是:"ActiveSheet.PasteSpecial Format:=" Text，link:= False，DisplayAsIcon:= False"，它失败并给我错误1004"PasteSpecial method of工作表类失败."

The portion that is puzzling me at the time is when it hits: "ActiveSheet.PasteSpecial Format:="Text", link:=False, DisplayAsIcon:=False" , it fails and gives me Error 1004 "PasteSpecial method of Worksheet class failed."

调试后按F8键，代码将继续正常运行(尽管向我显示无法在中断模式下执行代码3次).我尝试将代码更改为显示"Worksheets("GOOGLE")"，并且其他直接定义工作表的方法.我的直觉可能不是问题.如果是这种情况，我不知道这是怎么回事！有人可以测试一下吗?

On hitting F8 after debugging, the code continues just fine (albeit after showing me "Can't Execute code in break mode 3 times). I've tried altering the code to show "Worksheets("GOOGLE")" and other methods of defining the worksheet directly. My hunch is that may not be the issue. If that's the case, I have no idea what's going on here! Can someone test this out?

仅供参考，由于该代码运行时间可能很长，因此我还在此代码的上方使用了用户窗体"(无模式)作为等待"消息.不知道这是否会干扰粘贴.

FYI I also use a Userform (modeless) on top of this code as a "Waiting" message as it can be quite long to run. Not sure if this is interfering with the paste.

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

推荐答案

请尝试使用此方法，而不要在应用程序之间进行复制/粘贴.像您一样，我尝试过这种方法，但发现它不可靠，而且经常无法正常工作.

Try this method instead of copy/paste between applications. Like you, I tried that and found it unreliable and often didn't work.

您可以将字符串中的innerText捕获为字符串，然后使用它，也可以将innerText拆分为一个数组，然后将其放在表单上，​​就像我在示例中所做的那样.这样可以保留换行符，并且比将所有文本放在单个单元格中更具可读性

You can grab the page's innerText in a string and just use that, or, you could split the innerText in to an array and put that on the sheet, as I do in my example. This preserves the line breaks and makes it a bit more readable than putting all the text in a single cell

我在一个简单的示例( http://google.com )上对此进行了验证，证明这两种方法返回的结果完全相同工作表中单元格的布局.

I verify this on a simple example (http://google.com) that both methods return the exact same layout of cells in the worksheet.

注意::当您在IE中安装了ChromeFrameBHO加载项时，此方法可能不起作用(请参阅

NOTE: This method may not work when you have the ChromeFrameBHO Add-In installed in IE (see 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方法.它可能适合您，也可能不适合您，但是请尝试这样的操作.

Another method which doesn't rely on Internet Explorer is the QueryTables method. It may or may not be appropriate for your needs, but try something like this.

注意:无论是否安装了ChromeFrameBHO插件，这种方法(对我来说)似乎都有效.

NOTE: This method appears to work (for me) whether the ChromeFrameBHO plugin is installed.

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

这篇关于Excel2010:从IE复制时，PasteSpecial失败的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！