Pasting Problems with simple macro

[High Plains Grifter]

heloo people - I need to copy seeral thousand records from a windows programme into excel. Unfortunately, the program does not allow me to select all of the records at once, only one row at a time. However, I can select the top row, copy the contents with Ctrl+c, move down a row with the down arrow, then alt tab back to excel and paste the information into an appropriate cell.

I figured that I could shorten this process by making a little macro which would use the (I'll admit slighty grotty) Application.Sendkeys to do the work for me:

Sub copyfrom()
Dim i As Integer
Dim rng As Range
i = 1
Do
Set rng = Range("A1").Cells(i, 1)
Application.SendKeys ("%{TAB}")
Application.SendKeys ("^c")
Application.SendKeys ("{DOWN}")
Application.SendKeys ("%{TAB}")
rng.Select
Selection.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
i = i + 1
Loop Until ActiveCell.IsEmpty = True
End Sub

For some reason, Excel does not like the PasteSpecial bit of the macro. Any ideas why?

Any help gratefully received

ps. I made sure that the correct programme was "behind" Excel, and even repeated the experiment with another instance of Excel behind, but the error was the same: Run-time error '1004': Application-defined or object-defined error.

 

[Andrew Poulsom]

Try:

ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True

 

[High Plains Grifter]

Thanks for the quick reply - I tried as you suggested, and unfortunately it now gives me a different error...

Run-time error '438': Object doesn't support this property or method, again on the PasteSpecial line.

might this be an error caused by an empty clipboard at the time of pasting? If so, then the whole enterprise is doomed to fail...

thanks.

Addendum: Sorry - the error is now highlighting the Loop until... line with error # 438

I should wait before posting, I'm sorry; I changed the do..loop to an if, as follows:

Sub copyfrom()
Dim i As Integer
Dim rng As Range
i = 1
pseudodo:
        Set rng = Range("A1").Cells(i, 1)
        Application.SendKeys ("%{TAB}")
        Application.SendKeys ("^c")
        Application.SendKeys ("{DOWN}")
        Application.SendKeys ("%{TAB}")
        rng.Select
        ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
        i = i + 1
If Len(rng) <> 0 Then GoTo pseudodo
End Sub[CODE]
 
it now highlights the pastspecial line with this: Run-time error '1004' PasteSpecial method of Worksheet class failed...

 

[Andrew Poulsom]

Is there anything on the clipboard - can you paste special manually?

 

[High Plains Grifter]

I ran the macro, ended it when the error appeared and attempted to PasteSpecial. There is nothing in the clipboard.

Is this a problem with the use of

Application.SendKeys ("^c")

do you think?

I guess it could all be happening too quickly to really grasp the information from the other program?

 

[Andrew Poulsom]

Is this a problem with the use of

Application.SendKeys ("^c")

do you think?

Probably. What's the program?

 

[High Plains Grifter]

It's a custom built insurance software program that we are currently installing onto our computers - not one that is generally available.

I realise that this might be a simple thing to blame for the problem, but when I perform the actions manually, the copy and paste works fine. I'm not entirely sure what conclusion to draw from that fact, but there it is.

 

[High Plains Grifter]

Thanks for your help - I guess I should not underestimate the ultimate and wide ranging flexibility of one man with a pair of headphones and plenty of time - I'll do it manually :P

 

[High Plains Grifter]

Just for completness, and to let people know, I have managed to solve the problem by inserting a wait into the program, so that the computer has time to get its head in order before I start asking it to copy:

Sub copyfrom()
Dim i As Integer
Dim rng As Range
i = 1
pseudodo:
Set rng = Range("A1").Cells(i, 1)
Application.SendKeys ("%{TAB}"), True
Wait (0.1)
Application.SendKeys ("^c"), True
Application.SendKeys ("{DOWN}"), True
Application.SendKeys ("%{TAB}"), True
rng.Select
ActiveSheet.PasteSpecial Format:="HTML", link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
i = i + 1
If Len(rng) <> 0 Then GoTo pseudodo
End Sub
____________________________________________________________
 
Sub Wait(time As Single)
Dim expiry As Single
expiry = Timer + time
    Do While Timer < expiry
        DoEvents
    Loop
End Sub

for some unknown reason this copies every other record from the other programme, but I repeated the whole thing starting on the second record and captured them all. It is but a matter of moments to copy them all into one column and sort.