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
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