unbound pastespecial in Access

B

Brad Adams

I am having problems getting PasteSpecial to work in an Access Application I
have controlling an Excel Spreadsheet.

I've tried this line of code several different ways and no matter what I do
I always get the same error RT1004 Pastespecial method of Range Class
Failed.

The line of code in question is xlapp.selection.PasteSpecial
operation:=xlPasteValues

We are linking the final Excel Spreadsheet into a Business Object file and
it won't play nicely unless columns C:E are formatted as text AND have the
little green flag in the cells. Don't ask me why, I just work here :)

Any help would be greatly appreciated. Thanks, Brad.

Here is the entire module.

Sub ExportKeyStatsExcel(strFileName As String)

'late binding to excel
'replaces reference to excel dll
'prevents versioning issues
Dim xlapp As Object
Set xlapp = CreateObject("Excel.Application")
Dim wb As Object
Dim ws As Object
Dim rs As New ADODB.Recordset, rs2 As New ADODB.Recordset
Dim rng1 As Object
Dim fld As ADODB.Field
Dim strLastColumn As String, strLastRow As String

'create new workbook
Set wb = xlapp.workbooks.Add

rs2.Open "SELECT RevLocName FROM tblDeptSpec GROUP BY RevLocName " & _
"ORDER BY tblDeptSpec.RevLocName DESC", _
CurrentProject.Connection, adOpenStatic, adLockOptimistic

Do Until rs2.EOF
rs.Open "SELECT * FROM qryNewExport WHERE [Revenue Location Name] =
'" & _
rs2!RevLocName & "'", CurrentProject.Connection, adOpenKeyset,
adLockOptimistic

Set ws = wb.Worksheets.Add
ws.Name = rs2!RevLocName
xlapp.range("C:E").numberformat = "@"
xlapp.range("A1").select
For Each fld In rs.Fields
xlapp.activecell.formula = fld.Name
xlapp.activecell.offset(0, 1).select
Next fld

Set rng1 = xlapp.range("A2")
rng1.copyfromrecordset rs
strLastRow = rs.RecordCount + 1
If rs.RecordCount > 0 Then
xlapp.range("H2").formula = "=clean(C2)"
xlapp.range("H2").copy
xlapp.range("H2:J" & strLastRow).select
ws.Paste
xlapp.range("H2:J" & strLastRow).copy
xlapp.range("C2:E" & strLastRow).select
xlapp.selection.PasteSpecial operation:=xlPasteValues
xlapp.range("H2:J" & strLastRow).Delete
xlapp.range("A1").select
End If


rs.Close

rs2.MoveNext
Loop

'delete sheet1 to sheet3
xlapp.Worksheets("Sheet1").Delete
xlapp.Worksheets("Sheet2").Delete
xlapp.Worksheets("Sheet3").Delete

xlapp.displayalerts = False
wb.SaveAs FileName:=strFileName
xlapp.displayalerts = True

Set rng1 = Nothing
wb.Close
rs2.Close
Set rs = Nothing
Set rs2 = Nothing

Set wb = Nothing
xlapp.Application.Quit

Set xlapp = Nothing
 
T

Tom Ogilvy

Since your latebinding, the constant xlPasteValues is a uninitialized
variable and will be interpreted as having a value of 0. The actual value
is

? xlPasteValues
-4163


so replace xlPasteValues with -4163

--
Regards,
Tom Ogilvy

Brad Adams said:
I am having problems getting PasteSpecial to work in an Access Application I
have controlling an Excel Spreadsheet.

I've tried this line of code several different ways and no matter what I do
I always get the same error RT1004 Pastespecial method of Range Class
Failed.

The line of code in question is xlapp.selection.PasteSpecial
operation:=xlPasteValues

We are linking the final Excel Spreadsheet into a Business Object file and
it won't play nicely unless columns C:E are formatted as text AND have the
little green flag in the cells. Don't ask me why, I just work here :)

Any help would be greatly appreciated. Thanks, Brad.

Here is the entire module.

Sub ExportKeyStatsExcel(strFileName As String)

'late binding to excel
'replaces reference to excel dll
'prevents versioning issues
Dim xlapp As Object
Set xlapp = CreateObject("Excel.Application")
Dim wb As Object
Dim ws As Object
Dim rs As New ADODB.Recordset, rs2 As New ADODB.Recordset
Dim rng1 As Object
Dim fld As ADODB.Field
Dim strLastColumn As String, strLastRow As String

'create new workbook
Set wb = xlapp.workbooks.Add

rs2.Open "SELECT RevLocName FROM tblDeptSpec GROUP BY RevLocName " & _
"ORDER BY tblDeptSpec.RevLocName DESC", _
CurrentProject.Connection, adOpenStatic, adLockOptimistic

Do Until rs2.EOF
rs.Open "SELECT * FROM qryNewExport WHERE [Revenue Location Name] =
'" & _
rs2!RevLocName & "'", CurrentProject.Connection, adOpenKeyset,
adLockOptimistic

Set ws = wb.Worksheets.Add
ws.Name = rs2!RevLocName
xlapp.range("C:E").numberformat = "@"
xlapp.range("A1").select
For Each fld In rs.Fields
xlapp.activecell.formula = fld.Name
xlapp.activecell.offset(0, 1).select
Next fld

Set rng1 = xlapp.range("A2")
rng1.copyfromrecordset rs
strLastRow = rs.RecordCount + 1
If rs.RecordCount > 0 Then
xlapp.range("H2").formula = "=clean(C2)"
xlapp.range("H2").copy
xlapp.range("H2:J" & strLastRow).select
ws.Paste
xlapp.range("H2:J" & strLastRow).copy
xlapp.range("C2:E" & strLastRow).select
xlapp.selection.PasteSpecial operation:=xlPasteValues
xlapp.range("H2:J" & strLastRow).Delete
xlapp.range("A1").select
End If


rs.Close

rs2.MoveNext
Loop

'delete sheet1 to sheet3
xlapp.Worksheets("Sheet1").Delete
xlapp.Worksheets("Sheet2").Delete
xlapp.Worksheets("Sheet3").Delete

xlapp.displayalerts = False
wb.SaveAs FileName:=strFileName
xlapp.displayalerts = True

Set rng1 = Nothing
wb.Close
rs2.Close
Set rs = Nothing
Set rs2 = Nothing

Set wb = Nothing
xlapp.Application.Quit

Set xlapp = Nothing
 
B

Brad Adams

Thanks for all the help. Tom's advice worked and the file is now in the
format we need it.

Jamie, I agree your idea is simplier, but since this file has to link into
Business Objects the only way we can get it to work is with Excel and the
green triangles, I tried a text file with text qualifiers and it still
didn't work. I think it's just a Business Objects quirk that it wants the
green triangles to show up, because I had the cells formatted as text and
that's how Excel sees them, but Business Objects would not. Either way, the
reports are still easier to run now than they were 6 months ago.

Thanks again.

Brad
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top