Format Excel Sheet after DoCmd.TransferSpreadsheet

J

John

TBS - this has got to the the most frustrating problem!!! Here's where I
stand:
1. The code will run fine, one time except it leaves EXCEL.EXE running.
2. The next time I run the code, it will give me the '462' mentioned bellow.
3. If I kill Excel, delete the output files, and run the code again, I am
back to #1 above.

In an effort to figure out the problem, I did some code changes... didn't
help much but here's where I stand (not all the code... just starts were the
issues show up):

'==========>

FCnt = rs.Fields.Count
RCnt = rs.RecordCount

Set xlRng = xlSht.Cells(2, 1)
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlRng.Select
xlApp.ActiveWindow.FreezePanes = True
'**** the line below is where the error shows up...
Set xlRng = xlSht.Range(Cells(1, 1), Cells(RCnt + 1,
FCnt))
xlRng.Select
xlRng.AutoFilter
Set xlRng = xlSht.Range(Cells(2, 1), Cells(RCnt + 1,
FCnt))
xlRng.Select
With xlRng
.Font.name = "Arial"
.Font.Size = 8
End With
Set xlRng = xlSht.Cells(2, 1)
xlRng.Select
'**** Why isn't ".name" capitized like ".Name" in the line below?
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)
xlWkb.Save

'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing

'Display the spreadsheet?
If MsgBox("Do you want to see the exported data?",
vbYesNo + vbQuestion, "View Now?") = vbYes Then
FollowHyperlink fn
End If
End Select
'==========>

Sorry this is not working out and I'll buy you a beer (or two!) should the
opportunity ever present itself!

--
Thanks in advance!
**John**


tbs said:
yeah, I think I've spotted something.

xlSht.Columns.AutoFit
xlRng.Select ' <== insert this line before freeze panel.
xlApp.ActiveWindow.FreezePanes = True


John said:
Yes I did... I check it over again to see if I had a typo... I don't see one,
perhaps you can spot it...
++++++++++++++
'This is the default for generic Excel output...

'Dimention Database an Spreadsheet variabls...
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qry As DAO.QueryDef
Dim fld As DAO.Field
Dim FldCnt As Integer
Dim PCnt As Integer
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim xlRng As Excel.Range
Dim FlNm As String

Set db = CurrentDb
Set qry = db.QueryDefs(RunQry)
'get parameters...
If qry.Parameters.Count > 0 Then
For PCnt = 0 To qry.Parameters.Count - 1
Select Case qry.Parameters(PCnt).name
Case
"[Forms]![frmProjectCost]![CmbCurMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurMon]").Value =
DateValue(Me.CmbCurMon.Value)
Case
"[Forms]![frmProjectCost]![CmbPriMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriMon]").Value =
DateValue(Me.CmbPriMon.Value)
Case
"[Forms]![frmProjectCost]![CmbCurPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurPro]").Value =
DateValue(Me.CmbCurPro.Value)
Case
"[Forms]![frmProjectCost]![CmbPriPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriPro]").Value =
DateValue(Me.CmbPriPro.Value)
Case Else 'Unknown parameter
MsgBox "This selection is asking
for" & qry.Parameters(PCnt).name & ".", vbOKOnly, "Output Error!"

End Select
Next PCnt
Else
'No parameters in selected query
End If

Set rs = qry.OpenRecordset

'Create the spreadsheet
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Add
Set xlSht = xlWkb.Sheets(1)
xlWkb.SaveAs fn
FlNm = xlWkb.name
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)

'Populate field titles and format spreadsheet...
FldCnt = 1
For Each fld In rs.Fields
With xlSht.Cells(1, FldCnt)
.Value = fld.name
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.ColorIndex = 1
.Bold = True
.name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.UnderLine = xlUnderlineStyleNone
.ColorIndex = 1
End With
End With
FldCnt = FldCnt + 1
Next fld

Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlApp.ActiveWindow.FreezePanes = True
xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8
xlWkb.Save

'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing

++++++++++++++
--
Thanks in advance!
**John**


tbs said:
did you do this?
change:
Set xlSht = xlWkb.ActiveSheet
to:
Set xlSht = xlWkb.sheets(1)

I also got the same error initially but not after i've made the changes above.

:

TBS...

Feels like we are getting close. I am now getting the following error:

Run-time error: '462'
The remote server machine does not exist or is unavailable.

This occurs on the line after "xlApp.ActiveWindow.FreezePanes = True" which
is:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter

searching help doesn't help much...

Thanks again.

--
Thanks in advance!
**John**


:

Hi John,

I've tried to simulate your codes at my side and managed to find out the
cause to your problem.

change:
Set xlSht = xlWkb.ActiveSheet
to:
Set xlSht = xlWkb.sheets(1)

change:
ActiveWindow.FreezePanes = True
to:
xlApp.ActiveWindow.FreezePanes = True

Note that you have to be very specific and careful when you are using
"Active..." as it may go haywire at some point of your program. I would
advise you to avoid using it unless you have no other choices.

:

TBS - sorry it's taken so long... I took another approach. The problem is
that the Excel Application will not close! Everything else seems to be
working although it's not fully tested. If you can spot why Excel will not
close, it would be a great help.
=========
'Generic query output to Excel...
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qry As DAO.QueryDef
Dim fld As DAO.Field
Dim FldCnt As Integer
Dim PCnt As Integer
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim xlRng As Excel.Range
Dim FlNm As String

Set db = CurrentDb
Set qry = db.QueryDefs(RunQry)
'get parameters...
If qry.Parameters.Count > 0 Then
For PCnt = 0 To qry.Parameters.Count - 1
Select Case qry.Parameters(PCnt).name
Case "[Forms]![frmProjectCost]![CmbCurMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurMon]").Value =
DateValue(Me.CmbCurMon.Value)
Case "[Forms]![frmProjectCost]![CmbPriMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriMon]").Value =
DateValue(Me.CmbPriMon.Value)
Case "[Forms]![frmProjectCost]![CmbCurPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurPro]").Value =
DateValue(Me.CmbCurPro.Value)
Case "[Forms]![frmProjectCost]![CmbPriPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriPro]").Value =
DateValue(Me.CmbPriPro.Value)
Case Else 'Unknown parameter
MsgBox "This selection is asking for" &
qry.Parameters(PCnt).name & ".", vbOKOnly, "Output Error!"

End Select
Next PCnt
Else
'No parameters in selected query
End If

Set rs = qry.OpenRecordset

'Create the spreadsheet
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Add
Set xlSht = xlWkb.ActiveSheet
xlWkb.SaveAs fn 'fn is a string variable that is populated with the full
path and filename the user supplied...
FlNm = xlWkb.name
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)

'Populate field titles and format spreadsheet...
FldCnt = 1
For Each fld In rs.Fields
With xlSht.Cells(1, FldCnt)
.Value = fld.name
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.ColorIndex = 1
.Bold = True
.name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.UnderLine = xlUnderlineStyleNone
.ColorIndex = 1
End With
End With
FldCnt = FldCnt + 1
Next fld

Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlRng.Select
ActiveWindow.FreezePanes = True
xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
Click to expand...
Click to expand...
Click to expand...
 
T

trevorC via AccessMonster.com

You have to convert the " cells " reference to an RC reference

.range(A1:J10)

you can use the excel special cells - lastcell to get the last used cell and
then format the data from there.

let me know if you need more help
 
K

Ken Snell

These lines of code:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8



need to be this:

xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8


You must fully reference all objects in the EXCEL application, even when
they're the argument of another object.

See this Knowledge Base article for more details about qualifying objects in
VBA automation:
Excel automation fails second time code runs
http://support.microsoft.com/kb/178510/en-us


--

Ken Snell
http://www.accessmvp.com/KDSnell/



John said:
Yes I did... I check it over again to see if I had a typo... I don't see
one,
perhaps you can spot it...
++++++++++++++
'This is the default for generic Excel output...

'Dimention Database an Spreadsheet variabls...
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qry As DAO.QueryDef
Dim fld As DAO.Field
Dim FldCnt As Integer
Dim PCnt As Integer
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim xlRng As Excel.Range
Dim FlNm As String

Set db = CurrentDb
Set qry = db.QueryDefs(RunQry)
'get parameters...
If qry.Parameters.Count > 0 Then
For PCnt = 0 To qry.Parameters.Count - 1
Select Case qry.Parameters(PCnt).name
Case
"[Forms]![frmProjectCost]![CmbCurMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurMon]").Value =
DateValue(Me.CmbCurMon.Value)
Case
"[Forms]![frmProjectCost]![CmbPriMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriMon]").Value =
DateValue(Me.CmbPriMon.Value)
Case
"[Forms]![frmProjectCost]![CmbCurPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurPro]").Value =
DateValue(Me.CmbCurPro.Value)
Case
"[Forms]![frmProjectCost]![CmbPriPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriPro]").Value =
DateValue(Me.CmbPriPro.Value)
Case Else 'Unknown parameter
MsgBox "This selection is asking
for" & qry.Parameters(PCnt).name & ".", vbOKOnly, "Output Error!"

End Select
Next PCnt
Else
'No parameters in selected query
End If

Set rs = qry.OpenRecordset

'Create the spreadsheet
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Add
Set xlSht = xlWkb.Sheets(1)
xlWkb.SaveAs fn
FlNm = xlWkb.name
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)

'Populate field titles and format spreadsheet...
FldCnt = 1
For Each fld In rs.Fields
With xlSht.Cells(1, FldCnt)
.Value = fld.name
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.ColorIndex = 1
.Bold = True
.name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.UnderLine = xlUnderlineStyleNone
.ColorIndex = 1
End With
End With
FldCnt = FldCnt + 1
Next fld

Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlApp.ActiveWindow.FreezePanes = True
xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8
xlWkb.Save

'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing

++++++++++++++
--
Thanks in advance!
**John**


tbs said:
did you do this?
change:
Set xlSht = xlWkb.ActiveSheet
to:
Set xlSht = xlWkb.sheets(1)

I also got the same error initially but not after i've made the changes
above.

John said:
TBS...

Feels like we are getting close. I am now getting the following error:

Run-time error: '462'
The remote server machine does not exist or is unavailable.

This occurs on the line after "xlApp.ActiveWindow.FreezePanes = True"
which
is:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter

searching help doesn't help much...

Thanks again.

--
Thanks in advance!
**John**


:

Hi John,

I've tried to simulate your codes at my side and managed to find out
the
cause to your problem.

change:
Set xlSht = xlWkb.ActiveSheet
to:
Set xlSht = xlWkb.sheets(1)

change:
ActiveWindow.FreezePanes = True
to:
xlApp.ActiveWindow.FreezePanes = True

Note that you have to be very specific and careful when you are using
"Active..." as it may go haywire at some point of your program. I
would
advise you to avoid using it unless you have no other choices.

:

TBS - sorry it's taken so long... I took another approach. The
problem is
that the Excel Application will not close! Everything else seems
to be
working although it's not fully tested. If you can spot why Excel
will not
close, it would be a great help.
=========
'Generic query output to Excel...
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qry As DAO.QueryDef
Dim fld As DAO.Field
Dim FldCnt As Integer
Dim PCnt As Integer
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim xlRng As Excel.Range
Dim FlNm As String

Set db = CurrentDb
Set qry = db.QueryDefs(RunQry)
'get parameters...
If qry.Parameters.Count > 0 Then
For PCnt = 0 To qry.Parameters.Count - 1
Select Case qry.Parameters(PCnt).name
Case "[Forms]![frmProjectCost]![CmbCurMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurMon]").Value =
DateValue(Me.CmbCurMon.Value)
Case "[Forms]![frmProjectCost]![CmbPriMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriMon]").Value =
DateValue(Me.CmbPriMon.Value)
Case "[Forms]![frmProjectCost]![CmbCurPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurPro]").Value =
DateValue(Me.CmbCurPro.Value)
Case "[Forms]![frmProjectCost]![CmbPriPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriPro]").Value =
DateValue(Me.CmbPriPro.Value)
Case Else 'Unknown parameter
MsgBox "This selection is asking
for" &
qry.Parameters(PCnt).name & ".", vbOKOnly, "Output Error!"

End Select
Next PCnt
Else
'No parameters in selected query
End If

Set rs = qry.OpenRecordset

'Create the spreadsheet
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Add
Set xlSht = xlWkb.ActiveSheet
xlWkb.SaveAs fn 'fn is a string variable that is populated with the
full
path and filename the user supplied...
FlNm = xlWkb.name
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)

'Populate field titles and format spreadsheet...
FldCnt = 1
For Each fld In rs.Fields
With xlSht.Cells(1, FldCnt)
.Value = fld.name
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.ColorIndex = 1
.Bold = True
.name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.UnderLine = xlUnderlineStyleNone
.ColorIndex = 1
End With
End With
FldCnt = FldCnt + 1
Next fld

Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlRng.Select
ActiveWindow.FreezePanes = True
xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8
xlRng.Select
xlWkb.Save

'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing
=========
Click to expand...
Click to expand...
Click to expand...
 
T

trevorC via AccessMonster.com

Hi,
I think you'll find that the " cells " reference is not usable from access....
.......
 
K

Ken Snell

It is if you reference/qualify it with an object that is set to an EXCEL
worksheet object.
 
T

tbs

Hi John,

Try Ken Snell's solution. I think it'll work. Sorry that I didn't spotted
this earlier.


John said:
TBS - this has got to the the most frustrating problem!!! Here's where I
stand:
1. The code will run fine, one time except it leaves EXCEL.EXE running.
2. The next time I run the code, it will give me the '462' mentioned bellow.
3. If I kill Excel, delete the output files, and run the code again, I am
back to #1 above.

In an effort to figure out the problem, I did some code changes... didn't
help much but here's where I stand (not all the code... just starts were the
issues show up):

'==========>

FCnt = rs.Fields.Count
RCnt = rs.RecordCount

Set xlRng = xlSht.Cells(2, 1)
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlRng.Select
xlApp.ActiveWindow.FreezePanes = True
'**** the line below is where the error shows up...
Set xlRng = xlSht.Range(Cells(1, 1), Cells(RCnt + 1,
FCnt))
xlRng.Select
xlRng.AutoFilter
Set xlRng = xlSht.Range(Cells(2, 1), Cells(RCnt + 1,
FCnt))
xlRng.Select
With xlRng
.Font.name = "Arial"
.Font.Size = 8
End With
Set xlRng = xlSht.Cells(2, 1)
xlRng.Select
'**** Why isn't ".name" capitized like ".Name" in the line below?
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)
xlWkb.Save

'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing

'Display the spreadsheet?
If MsgBox("Do you want to see the exported data?",
vbYesNo + vbQuestion, "View Now?") = vbYes Then
FollowHyperlink fn
End If
End Select
'==========>

Sorry this is not working out and I'll buy you a beer (or two!) should the
opportunity ever present itself!

--
Thanks in advance!
**John**


tbs said:
yeah, I think I've spotted something.

xlSht.Columns.AutoFit
xlRng.Select ' <== insert this line before freeze panel.
xlApp.ActiveWindow.FreezePanes = True


John said:
Yes I did... I check it over again to see if I had a typo... I don't see one,
perhaps you can spot it...
++++++++++++++
'This is the default for generic Excel output...

'Dimention Database an Spreadsheet variabls...
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qry As DAO.QueryDef
Dim fld As DAO.Field
Dim FldCnt As Integer
Dim PCnt As Integer
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim xlRng As Excel.Range
Dim FlNm As String

Set db = CurrentDb
Set qry = db.QueryDefs(RunQry)
'get parameters...
If qry.Parameters.Count > 0 Then
For PCnt = 0 To qry.Parameters.Count - 1
Select Case qry.Parameters(PCnt).name
Case
"[Forms]![frmProjectCost]![CmbCurMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurMon]").Value =
DateValue(Me.CmbCurMon.Value)
Case
"[Forms]![frmProjectCost]![CmbPriMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriMon]").Value =
DateValue(Me.CmbPriMon.Value)
Case
"[Forms]![frmProjectCost]![CmbCurPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurPro]").Value =
DateValue(Me.CmbCurPro.Value)
Case
"[Forms]![frmProjectCost]![CmbPriPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriPro]").Value =
DateValue(Me.CmbPriPro.Value)
Case Else 'Unknown parameter
MsgBox "This selection is asking
for" & qry.Parameters(PCnt).name & ".", vbOKOnly, "Output Error!"

End Select
Next PCnt
Else
'No parameters in selected query
End If

Set rs = qry.OpenRecordset

'Create the spreadsheet
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Add
Set xlSht = xlWkb.Sheets(1)
xlWkb.SaveAs fn
FlNm = xlWkb.name
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)

'Populate field titles and format spreadsheet...
FldCnt = 1
For Each fld In rs.Fields
With xlSht.Cells(1, FldCnt)
.Value = fld.name
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.ColorIndex = 1
.Bold = True
.name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.UnderLine = xlUnderlineStyleNone
.ColorIndex = 1
End With
End With
FldCnt = FldCnt + 1
Next fld

Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlApp.ActiveWindow.FreezePanes = True
xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8
xlWkb.Save

'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing

++++++++++++++
--
Thanks in advance!
**John**


:

did you do this?
change:
Set xlSht = xlWkb.ActiveSheet
to:
Set xlSht = xlWkb.sheets(1)

I also got the same error initially but not after i've made the changes above.

:

TBS...

Feels like we are getting close. I am now getting the following error:

Run-time error: '462'
The remote server machine does not exist or is unavailable.

This occurs on the line after "xlApp.ActiveWindow.FreezePanes = True" which
is:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter

searching help doesn't help much...

Thanks again.

--
Thanks in advance!
**John**


:

Hi John,

I've tried to simulate your codes at my side and managed to find out the
cause to your problem.

change:
Set xlSht = xlWkb.ActiveSheet
to:
Set xlSht = xlWkb.sheets(1)

change:
ActiveWindow.FreezePanes = True
to:
xlApp.ActiveWindow.FreezePanes = True

Note that you have to be very specific and careful when you are using
"Active..." as it may go haywire at some point of your program. I would
advise you to avoid using it unless you have no other choices.

:

TBS - sorry it's taken so long... I took another approach. The problem is
that the Excel Application will not close! Everything else seems to be
working although it's not fully tested. If you can spot why Excel will not
close, it would be a great help.
=========
'Generic query output to Excel...
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qry As DAO.QueryDef
Dim fld As DAO.Field
Dim FldCnt As Integer
Dim PCnt As Integer
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim xlRng As Excel.Range
Dim FlNm As String

Set db = CurrentDb
Set qry = db.QueryDefs(RunQry)
'get parameters...
If qry.Parameters.Count > 0 Then
For PCnt = 0 To qry.Parameters.Count - 1
Select Case qry.Parameters(PCnt).name
Case "[Forms]![frmProjectCost]![CmbCurMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurMon]").Value =
DateValue(Me.CmbCurMon.Value)
Case "[Forms]![frmProjectCost]![CmbPriMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriMon]").Value =
DateValue(Me.CmbPriMon.Value)
Click to expand...
Click to expand...
Click to expand...
 
J

John

Ken and TBS - THANKS!!!! This has been a long thread and I am greatful for
the help. Everything seems to be working correctly now.

If I could impose one last time.. it seems the EXCEL.EXE application does
not actually terminate untile the "End Sub" command. Is this correct? When
I watch it in the task manager it will not go away until control is returned
back to the form with the "run" command button. The resson I ask is because
I wanted to ask the user if they want to open the file they just created. I
did this with the following:

Case "Excel"
 
T

tbs

it should ends after this statement => xlApp.Quit

John said:
Ken and TBS - THANKS!!!! This has been a long thread and I am greatful for
the help. Everything seems to be working correctly now.

If I could impose one last time.. it seems the EXCEL.EXE application does
not actually terminate untile the "End Sub" command. Is this correct? When
I watch it in the task manager it will not go away until control is returned
back to the form with the "run" command button. The resson I ask is because
I wanted to ask the user if they want to open the file they just created. I
did this with the following:

Case "Excel"
.
.
.
Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlRng.Select
xlApp.ActiveWindow.FreezePanes = True
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).AutoFilter
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).Font.Size = 8
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)
xlWkb.Save


'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Visible = True
xlApp.Quit
Set xlApp = Nothing

'Display the spreadsheet?
If MsgBox("Do you want to see the exported data?",
vbYesNo + vbQuestion, "View Now?") = vbYes Then
FollowHyperlink fn
End If
End Select

Case Else
MsgBox ("You must select an output option!")
'Do nothing... (This should never happen...)
End Select

End Sub

==========

If I always click "No" everything works fine. If I click "Yes", then Excel
opens but it just shows the application, no spreadsheet.

--
Thanks in advance!
**John**


Ken Snell said:
These lines of code:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8



need to be this:

xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8


You must fully reference all objects in the EXCEL application, even when
they're the argument of another object.

See this Knowledge Base article for more details about qualifying objects in
VBA automation:
Excel automation fails second time code runs
http://support.microsoft.com/kb/178510/en-us


--

Ken Snell
http://www.accessmvp.com/KDSnell/



John said:
Yes I did... I check it over again to see if I had a typo... I don't see
one,
perhaps you can spot it...
++++++++++++++
'This is the default for generic Excel output...

'Dimention Database an Spreadsheet variabls...
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qry As DAO.QueryDef
Dim fld As DAO.Field
Dim FldCnt As Integer
Dim PCnt As Integer
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim xlRng As Excel.Range
Dim FlNm As String

Set db = CurrentDb
Set qry = db.QueryDefs(RunQry)
'get parameters...
If qry.Parameters.Count > 0 Then
For PCnt = 0 To qry.Parameters.Count - 1
Select Case qry.Parameters(PCnt).name
Case
"[Forms]![frmProjectCost]![CmbCurMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurMon]").Value =
DateValue(Me.CmbCurMon.Value)
Case
"[Forms]![frmProjectCost]![CmbPriMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriMon]").Value =
DateValue(Me.CmbPriMon.Value)
Case
"[Forms]![frmProjectCost]![CmbCurPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurPro]").Value =
DateValue(Me.CmbCurPro.Value)
Case
"[Forms]![frmProjectCost]![CmbPriPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriPro]").Value =
DateValue(Me.CmbPriPro.Value)
Case Else 'Unknown parameter
MsgBox "This selection is asking
for" & qry.Parameters(PCnt).name & ".", vbOKOnly, "Output Error!"

End Select
Next PCnt
Else
'No parameters in selected query
End If

Set rs = qry.OpenRecordset

'Create the spreadsheet
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Add
Set xlSht = xlWkb.Sheets(1)
xlWkb.SaveAs fn
FlNm = xlWkb.name
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)

'Populate field titles and format spreadsheet...
FldCnt = 1
For Each fld In rs.Fields
With xlSht.Cells(1, FldCnt)
.Value = fld.name
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.ColorIndex = 1
.Bold = True
.name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.UnderLine = xlUnderlineStyleNone
.ColorIndex = 1
End With
End With
FldCnt = FldCnt + 1
Next fld

Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlApp.ActiveWindow.FreezePanes = True
xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8
xlWkb.Save

'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing

++++++++++++++
--
Thanks in advance!
**John**


:

did you do this?
change:
Set xlSht = xlWkb.ActiveSheet
to:
Set xlSht = xlWkb.sheets(1)

I also got the same error initially but not after i've made the changes
above.

:

TBS...

Feels like we are getting close. I am now getting the following error:

Run-time error: '462'
The remote server machine does not exist or is unavailable.

This occurs on the line after "xlApp.ActiveWindow.FreezePanes = True"
which
is:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter

searching help doesn't help much...

Thanks again.

--
Thanks in advance!
**John**


:

Hi John,

I've tried to simulate your codes at my side and managed to find out
the
cause to your problem.

change:
Set xlSht = xlWkb.ActiveSheet
to:
Set xlSht = xlWkb.sheets(1)

change:
ActiveWindow.FreezePanes = True
to:
xlApp.ActiveWindow.FreezePanes = True

Note that you have to be very specific and careful when you are using
"Active..." as it may go haywire at some point of your program. I
Click to expand...
Click to expand...
Click to expand...
 
K

Ken Snell

What value does the variable fn hold? It needs to be the full path and
filename of the file that you want to open.

--

Ken Snell
http://www.accessmvp.com/KDSnell/


John said:
Ken and TBS - THANKS!!!! This has been a long thread and I am greatful for
the help. Everything seems to be working correctly now.

If I could impose one last time.. it seems the EXCEL.EXE application does
not actually terminate untile the "End Sub" command. Is this correct?
When
I watch it in the task manager it will not go away until control is
returned
back to the form with the "run" command button. The resson I ask is
because
I wanted to ask the user if they want to open the file they just created.
I
did this with the following:

Case "Excel"
.
.
.
Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlRng.Select
xlApp.ActiveWindow.FreezePanes = True
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).AutoFilter
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).Font.Size = 8
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)
xlWkb.Save


'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Visible = True
xlApp.Quit
Set xlApp = Nothing

'Display the spreadsheet?
If MsgBox("Do you want to see the exported data?",
vbYesNo + vbQuestion, "View Now?") = vbYes Then
FollowHyperlink fn
End If
End Select

Case Else
MsgBox ("You must select an output option!")
'Do nothing... (This should never happen...)
End Select

End Sub

==========

If I always click "No" everything works fine. If I click "Yes", then
Excel
opens but it just shows the application, no spreadsheet.

--
Thanks in advance!
**John**


Ken Snell said:
These lines of code:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.Size = 8



need to be this:

xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8


You must fully reference all objects in the EXCEL application, even when
they're the argument of another object.

See this Knowledge Base article for more details about qualifying objects
in
VBA automation:
Excel automation fails second time code runs
http://support.microsoft.com/kb/178510/en-us


--

Ken Snell
http://www.accessmvp.com/KDSnell/



John said:
Yes I did... I check it over again to see if I had a typo... I don't
see
one,
perhaps you can spot it...
++++++++++++++
'This is the default for generic Excel output...

'Dimention Database an Spreadsheet variabls...
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qry As DAO.QueryDef
Dim fld As DAO.Field
Dim FldCnt As Integer
Dim PCnt As Integer
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim xlRng As Excel.Range
Dim FlNm As String

Set db = CurrentDb
Set qry = db.QueryDefs(RunQry)
'get parameters...
If qry.Parameters.Count > 0 Then
For PCnt = 0 To qry.Parameters.Count - 1
Select Case qry.Parameters(PCnt).name
Case
"[Forms]![frmProjectCost]![CmbCurMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurMon]").Value =
DateValue(Me.CmbCurMon.Value)
Case
"[Forms]![frmProjectCost]![CmbPriMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriMon]").Value =
DateValue(Me.CmbPriMon.Value)
Case
"[Forms]![frmProjectCost]![CmbCurPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurPro]").Value =
DateValue(Me.CmbCurPro.Value)
Case
"[Forms]![frmProjectCost]![CmbPriPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriPro]").Value =
DateValue(Me.CmbPriPro.Value)
Case Else 'Unknown parameter
MsgBox "This selection is asking
for" & qry.Parameters(PCnt).name & ".", vbOKOnly, "Output Error!"

End Select
Next PCnt
Else
'No parameters in selected query
End If

Set rs = qry.OpenRecordset

'Create the spreadsheet
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Add
Set xlSht = xlWkb.Sheets(1)
xlWkb.SaveAs fn
FlNm = xlWkb.name
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) -
4)

'Populate field titles and format spreadsheet...
FldCnt = 1
For Each fld In rs.Fields
With xlSht.Cells(1, FldCnt)
.Value = fld.name
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.ColorIndex = 1
.Bold = True
.name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.UnderLine = xlUnderlineStyleNone
.ColorIndex = 1
End With
End With
FldCnt = FldCnt + 1
Next fld

Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlApp.ActiveWindow.FreezePanes = True
xlSht.Range(Cells(1, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.Size = 8
xlWkb.Save

'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing

++++++++++++++
--
Thanks in advance!
**John**


:

did you do this?
change:
Set xlSht = xlWkb.ActiveSheet
to:
Set xlSht = xlWkb.sheets(1)

I also got the same error initially but not after i've made the
changes
above.

:

TBS...

Feels like we are getting close. I am now getting the following
error:

Run-time error: '462'
The remote server machine does not exist or is unavailable.

This occurs on the line after "xlApp.ActiveWindow.FreezePanes =
True"
which
is:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter

searching help doesn't help much...

Thanks again.

--
Thanks in advance!
**John**


:

Hi John,

I've tried to simulate your codes at my side and managed to find
out
the
cause to your problem.

change:
Set xlSht = xlWkb.ActiveSheet
to:
Set xlSht = xlWkb.sheets(1)

change:
ActiveWindow.FreezePanes = True
to:
xlApp.ActiveWindow.FreezePanes = True

Note that you have to be very specific and careful when you are
using
"Active..." as it may go haywire at some point of your program. I
would
advise you to avoid using it unless you have no other choices.

:

TBS - sorry it's taken so long... I took another approach. The
problem is
that the Excel Application will not close! Everything else
seems
to be
working although it's not fully tested. If you can spot why
Excel
will not
close, it would be a great help.
=========
'Generic query output to Excel...
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qry As DAO.QueryDef
Dim fld As DAO.Field
Dim FldCnt As Integer
Dim PCnt As Integer
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim xlRng As Excel.Range
Dim FlNm As String

Set db = CurrentDb
Set qry = db.QueryDefs(RunQry)
'get parameters...
If qry.Parameters.Count > 0 Then
For PCnt = 0 To qry.Parameters.Count - 1
Select Case qry.Parameters(PCnt).name
Case "[Forms]![frmProjectCost]![CmbCurMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurMon]").Value =
DateValue(Me.CmbCurMon.Value)
Case
"[Forms]![frmProjectCost]![CmbPriMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriMon]").Value =
DateValue(Me.CmbPriMon.Value)
Case
"[Forms]![frmProjectCost]![CmbCurPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurPro]").Value =
DateValue(Me.CmbCurPro.Value)
Case
"[Forms]![frmProjectCost]![CmbPriPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriPro]").Value =
DateValue(Me.CmbPriPro.Value)
Case Else 'Unknown parameter
MsgBox "This selection is
asking
for" &
qry.Parameters(PCnt).name & ".", vbOKOnly, "Output Error!"

End Select
Next PCnt
Else
'No parameters in selected query
End If

Set rs = qry.OpenRecordset

'Create the spreadsheet
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Add
Set xlSht = xlWkb.ActiveSheet
xlWkb.SaveAs fn 'fn is a string variable that is populated with
the
full
path and filename the user supplied...
FlNm = xlWkb.name
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)
Click to expand...
Click to expand...
Click to expand...
 
J

John

The fn variable is the full path and filename of the file the user just
created. It is captured using modGetFile by Ken Getz and Paul Litwin. (Yes,
way over my head, but they had great instructions on how to set it up and use
it.) The actual command line is:

fn = Save_FileName()

The Code for Save_FileName() is:

Function Save_FileName() As String
Dim strFilter As String
'Dim lngFlags As Long
Dim SaveFileName As String

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.XLS")
strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
Save_FileName = ahtCommonFileOpenSave( _
OpenFile:=False, InitialDir:="C:\", _
Filter:=strFilter, FilterIndex:=3, Flags:=ahtOFN_OVERWRITEPROMPT Or
ahtOFN_HIDEREADONLY, _
DialogTitle:="Save file to...")
End Function

If I open the TaskManager and then run the code to create the Excel file,
when the message box opens up and asks the user if they would like to open
the file, EXCEL.EXE is still running. If I click "No", excel then closes.
If I click yes, Excel does open, but only the outline of the application
shows with the toolbars. The spot where the spreadsheet should be is just a
"screen shot" of my desktop. Very odd.

Is it possible that I still have a reference to a cell or somthing that
creates another excel application but for some reason teh "End Sub" closes it?


--
Thanks in advance!
**John**


Ken Snell said:
What value does the variable fn hold? It needs to be the full path and
filename of the file that you want to open.

--

Ken Snell
http://www.accessmvp.com/KDSnell/


John said:
Ken and TBS - THANKS!!!! This has been a long thread and I am greatful for
the help. Everything seems to be working correctly now.

If I could impose one last time.. it seems the EXCEL.EXE application does
not actually terminate untile the "End Sub" command. Is this correct?
When
I watch it in the task manager it will not go away until control is
returned
back to the form with the "run" command button. The resson I ask is
because
I wanted to ask the user if they want to open the file they just created.
I
did this with the following:

Case "Excel"
.
.
.
Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlRng.Select
xlApp.ActiveWindow.FreezePanes = True
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).AutoFilter
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).Font.Size = 8
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)
xlWkb.Save


'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Visible = True
xlApp.Quit
Set xlApp = Nothing

'Display the spreadsheet?
If MsgBox("Do you want to see the exported data?",
vbYesNo + vbQuestion, "View Now?") = vbYes Then
FollowHyperlink fn
End If
End Select

Case Else
MsgBox ("You must select an output option!")
'Do nothing... (This should never happen...)
End Select

End Sub

==========

If I always click "No" everything works fine. If I click "Yes", then
Excel
opens but it just shows the application, no spreadsheet.

--
Thanks in advance!
**John**


Ken Snell said:
These lines of code:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.Size = 8



need to be this:

xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8


You must fully reference all objects in the EXCEL application, even when
they're the argument of another object.

See this Knowledge Base article for more details about qualifying objects
in
VBA automation:
Excel automation fails second time code runs
http://support.microsoft.com/kb/178510/en-us


--

Ken Snell
http://www.accessmvp.com/KDSnell/



Yes I did... I check it over again to see if I had a typo... I don't
see
one,
perhaps you can spot it...
++++++++++++++
'This is the default for generic Excel output...

'Dimention Database an Spreadsheet variabls...
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qry As DAO.QueryDef
Dim fld As DAO.Field
Dim FldCnt As Integer
Dim PCnt As Integer
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim xlRng As Excel.Range
Dim FlNm As String

Set db = CurrentDb
Set qry = db.QueryDefs(RunQry)
'get parameters...
If qry.Parameters.Count > 0 Then
For PCnt = 0 To qry.Parameters.Count - 1
Select Case qry.Parameters(PCnt).name
Case
"[Forms]![frmProjectCost]![CmbCurMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurMon]").Value =
DateValue(Me.CmbCurMon.Value)
Case
"[Forms]![frmProjectCost]![CmbPriMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriMon]").Value =
DateValue(Me.CmbPriMon.Value)
Case
"[Forms]![frmProjectCost]![CmbCurPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurPro]").Value =
DateValue(Me.CmbCurPro.Value)
Case
"[Forms]![frmProjectCost]![CmbPriPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriPro]").Value =
DateValue(Me.CmbPriPro.Value)
Case Else 'Unknown parameter
MsgBox "This selection is asking
for" & qry.Parameters(PCnt).name & ".", vbOKOnly, "Output Error!"

End Select
Next PCnt
Else
'No parameters in selected query
End If

Set rs = qry.OpenRecordset

'Create the spreadsheet
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Add
Set xlSht = xlWkb.Sheets(1)
xlWkb.SaveAs fn
FlNm = xlWkb.name
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) -
4)

'Populate field titles and format spreadsheet...
FldCnt = 1
For Each fld In rs.Fields
With xlSht.Cells(1, FldCnt)
.Value = fld.name
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.ColorIndex = 1
.Bold = True
.name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.UnderLine = xlUnderlineStyleNone
.ColorIndex = 1
End With
End With
FldCnt = FldCnt + 1
Next fld

Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlApp.ActiveWindow.FreezePanes = True
xlSht.Range(Cells(1, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.Size = 8
xlWkb.Save

'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing

++++++++++++++
--
Thanks in advance!
**John**


:

did you do this?
change:
Set xlSht = xlWkb.ActiveSheet
to:
Set xlSht = xlWkb.sheets(1)

I also got the same error initially but not after i've made the
changes
above.

:

TBS...

Feels like we are getting close. I am now getting the following
error:

Run-time error: '462'
The remote server machine does not exist or is unavailable.

This occurs on the line after "xlApp.ActiveWindow.FreezePanes =
True"
which
is:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter

searching help doesn't help much...
Click to expand...
Click to expand...
Click to expand...
 
J

John

I just discovered something else... If I answer "Yes" to see the file Excel
will open with the "screen shot" of my desktop showing where the spreadsheet
should be, however, if I click on "View", "Fullscreen" everyting shows up
fine. If I click on "View", "Fullscreen" again, Excel goes back looking like
it should. The spreadsheet is also showing fine, but it's not maximized in
the application window.

--
Thanks in advance!
**John**


Ken Snell said:
What value does the variable fn hold? It needs to be the full path and
filename of the file that you want to open.

--

Ken Snell
http://www.accessmvp.com/KDSnell/


John said:
Ken and TBS - THANKS!!!! This has been a long thread and I am greatful for
the help. Everything seems to be working correctly now.

If I could impose one last time.. it seems the EXCEL.EXE application does
not actually terminate untile the "End Sub" command. Is this correct?
When
I watch it in the task manager it will not go away until control is
returned
back to the form with the "run" command button. The resson I ask is
because
I wanted to ask the user if they want to open the file they just created.
I
did this with the following:

Case "Excel"
.
.
.
Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlRng.Select
xlApp.ActiveWindow.FreezePanes = True
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).AutoFilter
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).Font.Size = 8
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)
xlWkb.Save


'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Visible = True
xlApp.Quit
Set xlApp = Nothing

'Display the spreadsheet?
If MsgBox("Do you want to see the exported data?",
vbYesNo + vbQuestion, "View Now?") = vbYes Then
FollowHyperlink fn
End If
End Select

Case Else
MsgBox ("You must select an output option!")
'Do nothing... (This should never happen...)
End Select

End Sub

==========

If I always click "No" everything works fine. If I click "Yes", then
Excel
opens but it just shows the application, no spreadsheet.

--
Thanks in advance!
**John**


Ken Snell said:
These lines of code:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.Size = 8



need to be this:

xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8


You must fully reference all objects in the EXCEL application, even when
they're the argument of another object.

See this Knowledge Base article for more details about qualifying objects
in
VBA automation:
Excel automation fails second time code runs
http://support.microsoft.com/kb/178510/en-us


--

Ken Snell
http://www.accessmvp.com/KDSnell/



Yes I did... I check it over again to see if I had a typo... I don't
see
one,
perhaps you can spot it...
++++++++++++++
'This is the default for generic Excel output...

'Dimention Database an Spreadsheet variabls...
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qry As DAO.QueryDef
Dim fld As DAO.Field
Dim FldCnt As Integer
Dim PCnt As Integer
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim xlRng As Excel.Range
Dim FlNm As String

Set db = CurrentDb
Set qry = db.QueryDefs(RunQry)
'get parameters...
If qry.Parameters.Count > 0 Then
For PCnt = 0 To qry.Parameters.Count - 1
Select Case qry.Parameters(PCnt).name
Case
"[Forms]![frmProjectCost]![CmbCurMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurMon]").Value =
DateValue(Me.CmbCurMon.Value)
Case
"[Forms]![frmProjectCost]![CmbPriMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriMon]").Value =
DateValue(Me.CmbPriMon.Value)
Case
"[Forms]![frmProjectCost]![CmbCurPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurPro]").Value =
DateValue(Me.CmbCurPro.Value)
Case
"[Forms]![frmProjectCost]![CmbPriPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriPro]").Value =
DateValue(Me.CmbPriPro.Value)
Case Else 'Unknown parameter
MsgBox "This selection is asking
for" & qry.Parameters(PCnt).name & ".", vbOKOnly, "Output Error!"

End Select
Next PCnt
Else
'No parameters in selected query
End If

Set rs = qry.OpenRecordset

'Create the spreadsheet
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Add
Set xlSht = xlWkb.Sheets(1)
xlWkb.SaveAs fn
FlNm = xlWkb.name
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) -
4)

'Populate field titles and format spreadsheet...
FldCnt = 1
For Each fld In rs.Fields
With xlSht.Cells(1, FldCnt)
.Value = fld.name
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.ColorIndex = 1
.Bold = True
.name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.UnderLine = xlUnderlineStyleNone
.ColorIndex = 1
End With
End With
FldCnt = FldCnt + 1
Next fld

Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlApp.ActiveWindow.FreezePanes = True
xlSht.Range(Cells(1, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.Size = 8
xlWkb.Save

'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing

++++++++++++++
--
Thanks in advance!
**John**


:

did you do this?
change:
Set xlSht = xlWkb.ActiveSheet
to:
Set xlSht = xlWkb.sheets(1)

I also got the same error initially but not after i've made the
changes
above.

:

TBS...

Feels like we are getting close. I am now getting the following
error:

Run-time error: '462'
The remote server machine does not exist or is unavailable.

This occurs on the line after "xlApp.ActiveWindow.FreezePanes =
True"
which
is:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter

searching help doesn't help much...
Click to expand...
Click to expand...
Click to expand...
 
M

mcescher

I just discovered something else... If I answer "Yes" to see the file Excel
will open with the "screen shot" of my desktop showing where the spreadsheet
should be, however, if I click on "View", "Fullscreen" everyting shows up
fine.  If I click on "View", "Fullscreen" again, Excel goes back looking like
it should.  The spreadsheet is also showing fine, but it's not maximized in
the application window.

--
Thanks in advance!
**John**



Ken Snell said:
What value does the variable fn hold? It needs to be the full path and
filename of the file that you want to open.

        Ken Snell
http://www.accessmvp.com/KDSnell/
Click to expand...
John said:
Ken and TBS - THANKS!!!! This has been a long thread and I am greatful for
the help.  Everything seems to be working correctly now.
If I could impose one last time.. it seems the EXCEL.EXE application does
not actually terminate untile the "End Sub" command.  Is this correct?
When
I watch it in the task manager it will not go away until control is
returned
back to the form with the "run" command button.  The resson I ask is
because
I wanted to ask the user if they want to open the file they just created.
I
did this with the following:
    Case "Excel"
    .
    .
    .
                       Set xlRng = xlSht.Range("A2")
                       xlRng.Select
                       xlRng.CopyFromRecordset rs
                       xlSht.Columns.AutoFit
                       xlRng.Select
                       xlApp.ActiveWindow.FreezePanes = True
                       xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).AutoFilter
                       xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).Font.name = "Arial"
                       xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).Font.Size = 8
                       xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)
                       xlWkb.Save
                       'Clean-up, and exit
                       rs.Close
                       qry.Close
                       Set fld = Nothing
                       Set rs = Nothing
                       Set qry = Nothing
                       Set db = Nothing
                       Set xlRng = Nothing
                       Set xlSht = Nothing
                       xlWkb.Close
                       Set xlWkb = Nothing
                       xlApp.Visible = True
                       xlApp.Quit
                       Set xlApp = Nothing
                       'Display the spreadsheet?
                       If MsgBox("Do you wantto see the exported data?",
vbYesNo + vbQuestion, "View Now?") = vbYes Then
                           FollowHyperlink fn
                       End If
               End Select
           Case Else
               MsgBox ("You must select an output option!")
               'Do nothing... (This should never happen...)
       End Select
End Sub
==========
If I always click "No" everything works fine.  If I click "Yes", then
Excel
opens but it just shows the application, no spreadsheet.
--
Thanks in advance!
**John**
:
These lines of code:
                        xlSht.Range(Cells(1,1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).AutoFilter
                        xlSht.Range(Cells(2,1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.name = "Arial"
                        xlSht.Range(Cells(2,1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.Size = 8
need to be this:
                        xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
                        xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
                        xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8
You must fully reference all objects in the EXCEL application, even when
they're the argument of another object.
See this Knowledge Base article for more details about qualifying objects
in
VBA automation:
Excel automation fails second time code runs
http://support.microsoft.com/kb/178510/en-us
--
        Ken Snell
http://www.accessmvp.com/KDSnell/
Yes I did... I check it over again to see if I had a typo... I don't
see
one,
perhaps you can spot it...
++++++++++++++
                       'This is the default for generic Excel output...
                       'Dimention Databasean Spreadsheet variabls...
                       Dim db As DAO.Database
                       Dim rs As DAO.Recordset
                       Dim qry As DAO.QueryDef
                       Dim fld As DAO.Field
                       Dim FldCnt As Integer
                       Dim PCnt As Integer
                       Dim xlApp As Excel.Application
                       Dim xlWkb As Excel.Workbook
                       Dim xlSht As Excel.Worksheet
                       Dim xlRng As Excel.Range
                       Dim FlNm As String
                       Set db = CurrentDb
                       Set qry = db.QueryDefs(RunQry)
                       'get parameters...
                       If qry.Parameters.Count > 0 Then
                           For PCnt = 0 To qry.Parameters.Count - 1
                               Select Case qry.Parameters(PCnt).name
                                   Case
"[Forms]![frmProjectCost]![CmbCurMon]"
qry.Parameters("[Forms]![frmProjectCost]![CmbCurMon]").Value =
DateValue(Me.CmbCurMon.Value)
                                   Case
"[Forms]![frmProjectCost]![CmbPriMon]"
qry.Parameters("[Forms]![frmProjectCost]![CmbPriMon]").Value =
DateValue(Me.CmbPriMon.Value)
                                   Case
"[Forms]![frmProjectCost]![CmbCurPro]"
qry.Parameters("[Forms]![frmProjectCost]![CmbCurPro]").Value =
DateValue(Me.CmbCurPro.Value)
                                   Case
"[Forms]![frmProjectCost]![CmbPriPro]"
qry.Parameters("[Forms]![frmProjectCost]![CmbPriPro]").Value =
DateValue(Me.CmbPriPro.Value)
                                   Case Else 'Unknown parameter
                                       MsgBox "This selection is asking
for" & qry.Parameters(PCnt).name & ".", vbOKOnly, "Output Error!"
                               EndSelect
                           Next PCnt
                       Else
                           'No parameters in selected query
                       End If
                       Set rs = qry.OpenRecordset
                       'Create the spreadsheet
                       Set xlApp = New Excel.Application
                       Set xlWkb = xlApp..Workbooks.Add
                       Set xlSht = xlWkb..Sheets(1)
                       xlWkb.SaveAs fn
                       FlNm = xlWkb.name
                       xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) -
4)
                       'Populate field titles and format spreadsheet...
                       FldCnt = 1
                       For Each fld In rs.Fields
                           With xlSht.Cells(1, FldCnt)
                               .Value = fld.name
                               .Interior.ColorIndex = 15
                               .Interior.Pattern = xlSolid
                               .HorizontalAlignment = xlCenter
                               .VerticalAlignment = xlBottom
                               .WrapText = False
                               .Orientation = 0
                               .AddIndent = False
                               .IndentLevel = 0
                               .ShrinkToFit = False
                               .ReadingOrder = xlContext
                               .MergeCells = False
                               With .Font
                                   .ColorIndex = 1
                                   .Bold = True
                                   .name = "Arial"
                                   .Size = 8
                                   .Strikethrough = False
                                   .Superscript = False
                                   .Subscript = False
                                   .OutlineFont = False
                                   .Shadow = False
                                   .UnderLine = xlUnderlineStyleNone
                                   .ColorIndex = 1
                               EndWith
                           End With
                           FldCnt = FldCnt + 1
                       Next fld
Click to expand...
Click to expand...

...

read more »- Hide quoted text -

- Show quoted text -
Click to expand...

Could it be that your computer is playing an April Fools joke on you?
 
J

John

Ken and TBS,

This one I think I figured out on my own! Here's what I did and it seems to
be working fine:


..
..
..
'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing

If MsgBox("Do you want to open " & fn & "?", vbYesNo
+ vbQuestion, "View " & FlNm) = vbNo Then
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing
Else
xlApp.Visible = True
End If
End Select
End Sub

If this is "bad programing" for some reason please advise...

--
Thanks in advance!
**John**


Ken Snell said:
What value does the variable fn hold? It needs to be the full path and
filename of the file that you want to open.

--

Ken Snell
http://www.accessmvp.com/KDSnell/


John said:
Ken and TBS - THANKS!!!! This has been a long thread and I am greatful for
the help. Everything seems to be working correctly now.

If I could impose one last time.. it seems the EXCEL.EXE application does
not actually terminate untile the "End Sub" command. Is this correct?
When
I watch it in the task manager it will not go away until control is
returned
back to the form with the "run" command button. The resson I ask is
because
I wanted to ask the user if they want to open the file they just created.
I
did this with the following:

Case "Excel"
.
.
.
Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlRng.Select
xlApp.ActiveWindow.FreezePanes = True
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).AutoFilter
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1, rs.Fields.Count)).Font.Size = 8
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) - 4)
xlWkb.Save


'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Visible = True
xlApp.Quit
Set xlApp = Nothing

'Display the spreadsheet?
If MsgBox("Do you want to see the exported data?",
vbYesNo + vbQuestion, "View Now?") = vbYes Then
FollowHyperlink fn
End If
End Select

Case Else
MsgBox ("You must select an output option!")
'Do nothing... (This should never happen...)
End Select

End Sub

==========

If I always click "No" everything works fine. If I click "Yes", then
Excel
opens but it just shows the application, no spreadsheet.

--
Thanks in advance!
**John**


Ken Snell said:
These lines of code:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.Size = 8



need to be this:

xlSht.Range(xlSht.Cells(1, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter
xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(xlSht.Cells(2, 1),
xlSht.Cells(rs.RecordCount + 1,
rs.Fields.Count)).Font.Size = 8


You must fully reference all objects in the EXCEL application, even when
they're the argument of another object.

See this Knowledge Base article for more details about qualifying objects
in
VBA automation:
Excel automation fails second time code runs
http://support.microsoft.com/kb/178510/en-us


--

Ken Snell
http://www.accessmvp.com/KDSnell/



Yes I did... I check it over again to see if I had a typo... I don't
see
one,
perhaps you can spot it...
++++++++++++++
'This is the default for generic Excel output...

'Dimention Database an Spreadsheet variabls...
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qry As DAO.QueryDef
Dim fld As DAO.Field
Dim FldCnt As Integer
Dim PCnt As Integer
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht As Excel.Worksheet
Dim xlRng As Excel.Range
Dim FlNm As String

Set db = CurrentDb
Set qry = db.QueryDefs(RunQry)
'get parameters...
If qry.Parameters.Count > 0 Then
For PCnt = 0 To qry.Parameters.Count - 1
Select Case qry.Parameters(PCnt).name
Case
"[Forms]![frmProjectCost]![CmbCurMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurMon]").Value =
DateValue(Me.CmbCurMon.Value)
Case
"[Forms]![frmProjectCost]![CmbPriMon]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriMon]").Value =
DateValue(Me.CmbPriMon.Value)
Case
"[Forms]![frmProjectCost]![CmbCurPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbCurPro]").Value =
DateValue(Me.CmbCurPro.Value)
Case
"[Forms]![frmProjectCost]![CmbPriPro]"

qry.Parameters("[Forms]![frmProjectCost]![CmbPriPro]").Value =
DateValue(Me.CmbPriPro.Value)
Case Else 'Unknown parameter
MsgBox "This selection is asking
for" & qry.Parameters(PCnt).name & ".", vbOKOnly, "Output Error!"

End Select
Next PCnt
Else
'No parameters in selected query
End If

Set rs = qry.OpenRecordset

'Create the spreadsheet
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Add
Set xlSht = xlWkb.Sheets(1)
xlWkb.SaveAs fn
FlNm = xlWkb.name
xlSht.name = Left(Trim(FlNm), Len(Trim(FlNm)) -
4)

'Populate field titles and format spreadsheet...
FldCnt = 1
For Each fld In rs.Fields
With xlSht.Cells(1, FldCnt)
.Value = fld.name
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.ColorIndex = 1
.Bold = True
.name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.UnderLine = xlUnderlineStyleNone
.ColorIndex = 1
End With
End With
FldCnt = FldCnt + 1
Next fld

Set xlRng = xlSht.Range("A2")
xlRng.Select
xlRng.CopyFromRecordset rs
xlSht.Columns.AutoFit
xlApp.ActiveWindow.FreezePanes = True
xlSht.Range(Cells(1, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).AutoFilter
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.name = "Arial"
xlSht.Range(Cells(2, 1), Cells(rs.RecordCount +
1,
rs.Fields.Count)).Font.Size = 8
xlWkb.Save

'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing

++++++++++++++
--
Thanks in advance!
**John**


:

did you do this?
change:
Set xlSht = xlWkb.ActiveSheet
to:
Set xlSht = xlWkb.sheets(1)

I also got the same error initially but not after i've made the
changes
above.

:

TBS...

Feels like we are getting close. I am now getting the following
error:

Run-time error: '462'
The remote server machine does not exist or is unavailable.

This occurs on the line after "xlApp.ActiveWindow.FreezePanes =
True"
which
is:

xlSht.Range(Cells(1, 1), Cells(rs.RecordCount + 1,
rs.Fields.Count)).AutoFilter

searching help doesn't help much...
Click to expand...
Click to expand...
Click to expand...
 
K

Ken Snell

John said:
Ken and TBS,

This one I think I figured out on my own! Here's what I did and it seems
to
be working fine:


.
.
.
'Clean-up, and exit
rs.Close
qry.Close
Set fld = Nothing
Set rs = Nothing
Set qry = Nothing
Set db = Nothing
Set xlRng = Nothing

If MsgBox("Do you want to open " & fn & "?",
vbYesNo
+ vbQuestion, "View " & FlNm) = vbNo Then
Set xlSht = Nothing
xlWkb.Close
Set xlWkb = Nothing
xlApp.Quit
Set xlApp = Nothing
Else
xlApp.Visible = True
End If
End Select
End Sub

If this is "bad programing" for some reason please advise...
Click to expand...



Looks like acceptable coding to me, although I'd probably put the "Set xlSht
= Nothing" code step above the If block, up with where you set the other
similar objects to Nothing.
 

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

Similar Threads

Word macro that can call cells out of Excel for a find and replace 0
how to show last record 0
VBA Export to PDF 0
Working with Excel in Access 1
Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0
VBA for Dependents shortcut menu 0
Excel.exe not closing after transferspreadsheet 1
Word Macro for multiple searches, incl. in footnotes 2

Top