Export to Excel works - but manipulate the worksheet

[Chris]

Hi,

I am using:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
lcQueryName, strFilePathNamE, True

....to export my query data to an existing excel workbook. Then what i
need to do is sort the data and then copy and paste it to another
sheet in the workbook. I have managed to do similar things bofore but
only when i use the line:

DoCmd.OutputTo acExport, lcQueryName, , strFilePathNamE, True, ""

....this if i am not mistaken creates a new workbook - the problem
there being that i need to use an existing workbook.

In the past i have recorded a macro in Excel and then ripped the code
and put it into Access VBA then placed a snipit of code before each
line to make it work. But it isn't working this time.

Any ideas?
Cheers,

[ajamrozek]

If you can instantiate and Excel workbook object like so : Dim
objXLApp As Object, objXLBook As Object
then set the values to the files you want like so: Set objXLApp =
CreateObject("Excel.Application")
and Set objXLBook =
objXLApp.Workbooks.Open("\\server\existingfile.xls ")
Then go crazy and add sheets or edit existing sheets like so:
objXLBook.Sheets(0).Select
With objXLBook.worksheets(0)
End With
That might get you going in the right direction.
I have an export procedure that pastes data into a newly created
workbook and modifies formatting and the like.

Public Sub outToNSIR(strNSIRID As String)

Dim rsNSIR As Recordset, intA As Integer, objXLApp As Object, objXLBook
As Object, intb As Integer, _
strA As String, varOutVal
Set rsNSIR = CurrentDb.OpenRecordset("Select * from tblNSIR where
NSIR_ID = '" & strNSIRID & "'")

rsNSIR.MoveFirst
Set objXLApp = CreateObject("Excel.Application")

Dim blFndLstFil As Boolean, strLstFil As String, intLstDat As Integer

intLstDat = 0

While Not blFndLstFil
strLstFil = Dir("\\netltnm02\bridb\- Q-SCORE 2003\03.ExPRESS
Tools\NSIR template\NSIR_Form_" & Format(Date - intLstDat, "mmddyy") &
".xls")

If strLstFil <> "" Then
blFndLstFil = True
Else
intLstDat = intLstDat + 1

End If

Wend
Set objXLBook = objXLApp.Workbooks.Open("\\netltnm02\bridb\- Q-SCORE
2003\03.ExPRESS Tools\NSIR template\" & strLstFil)

If Dir("C:\NSIR", vbDirectory) = "" Then
MkDir ("C:\NSIR")
End If
If Dir("C:\NSIR\output", vbDirectory) = "" Then
MkDir ("C:\NSIR\output")
End If

objXLBook.SaveAs ("C:\NSIR\Output\NSIR_Form_" & strNSIRID & ".xls")

objXLBook.Close

Set objXLBook = objXLApp.Workbooks.Open("C:\NSIR\Output\NSIR_Form_ " &
strNSIRID & ".xls")

objXLApp.Visible = True
For intb = 2 To objXLBook.worksheets.Count - 1

objXLBook.Sheets(intb).Select

With objXLBook.worksheets(intb)
If intb = 2 Then

.Range("A7:A7").EntireRow.Insert

.Cells(7, 1).Interior.ColorIndex = 33
.Cells(7, 2).Interior.ColorIndex = 33
.Cells(7, 3).Interior.ColorIndex = 33

.Cells(7, 1) = "NSIR Tracking Number:"
.Cells(7, 2) = "x"
.Cells(7, 2).Font.ColorIndex = 33
.Cells(7, 3) = strNSIRID
.Cells(7, 3).Font.Bold = True
.Cells(7, 3).Font.Size = 10

Else

.Range("A4:A4").EntireRow.Insert

.Cells(4, 1).Interior.ColorIndex = 33
.Cells(4, 2).Interior.ColorIndex = 33
.Cells(4, 3).Interior.ColorIndex = 33

.Cells(4, 1) = "NSIR Tracking Number:"
.Cells(4, 3) = strNSIRID
.Cells(4, 3).Font.Bold = True
.Cells(4, 3).Font.Size = 10

End If

End With

Next

For intA = 0 To rsNSIR.Fields.Count - 1

For intb = 1 To objXLBook.worksheets.Count

With objXLBook.worksheets(intb)

strA = ""

If Not IsNull(rsNSIR(intA)) And Not IsNull(DLookup("Field",
"tblFieldNamesXRef", "[DB_Field] = '" & rsNSIR.Fields(intA).Name &
"'")) Then

On Error GoTo FindErr

strA = .Cells.Find(What:=DLookup("Field",
"tblFieldNamesXRef", "[DB_Field] = '" & rsNSIR.Fields(intA).Name & "'")
_
, SearchOrder:=1, LookAt:=1,
SearchDirection:=xlPrevious).Address

FindErr: Resume Next
If strA <> "" Then

objXLBook.Sheets(intb).Select

strA = "C" & Right(strA, Len(strA) - 3)
If IsDate(rsNSIR(intA)) Then

If InStr(1, rsNSIR(intA).Name, "Date") Then

varOutVal = Format(rsNSIR(intA),
"mm/dd/yy")
Else

varOutVal = "'" & rsNSIR(intA)
End If

ElseIf rsNSIR(intA) = True And rsNSIR(intA).Type =
1 Then

varOutVal = "yes"

Else
varOutVal = rsNSIR(intA)

End If

.Cells(Int(Right(strA, Len(strA) - 1)), 3) =
varOutVal

End If

End If
End With

Next

Next

If Dir("C:\NSIR\Output\", vbDirectory) = "" Then
MkDir ("C:\NSIR\Output\")
End If

objXLBook.Save
MsgBox "Output procedure complete."

End Sub