问题
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.
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."
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
回答1:
Try this method instead of copy/paste between applications. Like you, I tried that and found it unreliable and often didn't work.
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
I verify this on a simple example (http://google.com) that both methods return the exact same layout of cells in the worksheet.
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
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.
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
回答2:
I actually have been struggling with this exact same issue from copy and pasting a bunch of images. Excel 2010 apparently has issues with trying to paste before the copy command is complete. What you can do is a combination of the sleep event and error handling the specific 1004 error. Set up the error handler to catch the 1004 error, and just have it resume. What I did was set up a counter like this:
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
You don't need to use an error counter, but I thoguht it would be a good idea to keep future users of my spreadsheet from somehow creating an infinite loop. I also would clear the clipboard after each image paste, and if you use an error counter, reset it to 0 after a paste is successful.
回答3:
It looks like you're copying but you're clearing the clipboard before you paste so there's nothing for the code to paste.
Worksheets("GOOGLE").Range("A1").Copy
Application.CutCopyMode = False
Also, are you copying from Sheets("Google").Range("A1") to Sheets("Google").Range("A1")? I don't understand that
回答4:
I am not in a position to verify my response but I had a similar issue about a year ago. The webpage in question had to use a copy/paste rather than using innertext. It seems you have done most of what I did including pausing waiting or the copy to complete. (Readystate was unhelpful for me.)
The last thing I remember doing, which allowed the code to work, was to place the paste in a finite loop. The paste was typically successful between the third and eighth attempt.
I'm sure there is a better way but was unable to find it. Since my application was for my own use the code was acceptable. As the webpage would change every few months, the code was abandoned.
来源：https://stackoverflow.com/questions/18645445/excel2010-pastespecial-failing-when-copying-from-ie