Exporting to Excel

[JDU]

I have a code that I use to export a schedule created in Access to Excel. I have to manually open the excel file before exporting, otherwise I get an error. Is there any way to open it automatically before the export so that the users don't have to remember to open it. I am including the relevant part of the code.

Set xlSheet = GetObject(CurrentPath & "\Weekly Schedule.xls&quot
Set SchedQuery = CurrentDb.OpenRecordset("qryWeeklySchedule", dbOpenDynaset)

SchedQuery.MoveFirst
x = 8

xlSheet.Sheets(1).Activate
With xlSheet.ActiveSheet
.Range("A8:H47&quot.ClearContents
.Range("A64:H109&quot.ClearContents

Do While Not SchedQuery.EOF
Select Case x
Case Is = 16
.Cells(x, 1).Value = " "
x = x + 1
Case Is = 18
.Cells(x, 1).Value = "Days"
x = x + 1
Case Is = 38
.Cells(x, 1).Value = "Other"
x = x + 1

Thanks

 

[KyleS]

Use this:

Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application&quot

objExcel.OpenWorkbooks.Open CurrentPath & "\Weekly Schedule.xls"

Set xlSheet = objExcel.CurrentWorkbook
Set SchedQuery = CurrentDb.OpenRecordset("qryWeeklySchedule", dbOpenDynaset)

SchedQuery.MoveFirst
x = 8

xlSheet.Sheets(1).Activate
With xlSheet.ActiveSheet
.Range("A8:H47&quot.ClearContents
.Range("A64:H109&quot.ClearContents

Do While Not SchedQuery.EOF
Select Case x
Case Is = 16
.Cells(x, 1).Value = " "
x = x + 1
Case Is = 18
.Cells(x, 1).Value = "Days"
x = x + 1
Case Is = 38
.Cells(x, 1).Value = "Other"
x = x + 1 Kyle

 

[JDU]

Unfortunately I kept getting the error that this property was not supported for this object on this line.

objExcel.OpenWorkbooks.Open CurrentPath & "\Weekly Schedule.xls"

However I did find this code in the help files for GetObject example which might work I believe?

But I keep getting the message that only comments can appear below end sub, end function etc. ( I believe the culprit is the Declare Function Line, I am not familiar with this). Can someone please help me with this one. Thanks

' Declare necessary API routines:
Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName as String, _
ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd as Long,ByVal wMsg as Long, _
ByVal wParam as Long, _
ByVal lParam As Long) As Long
Sub GetExcel()
'Dim xlSheet As Object ' Variable to hold reference
' to Microsoft Excel.
Dim ExcelWasNotRunning As Boolean ' Flag for final release.

' Test to see if there is a copy of Microsoft Excel already running.
On Error Resume Next ' Defer error trapping.
' Getobject function called without the first argument returns a
' reference to an instance of the application. If the application isn't
' running, an error occurs.
Set xlSheet = GetObject(, "Excel.Application&quot
If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear ' Clear Err object in case error occurred.

' Check for Microsoft Excel. If Microsoft Excel is running,
' enter it into the Running Object table.
DetectExcel

' Set the object variable to reference the file you want to see.
Set xlSheet = GetObject(CurrentPath & &quot;\Weekly Schedule.xls&quot

' Show Microsoft Excel through its Application property. Then
' show the actual window containing the file using the Windows
' collection of the xlSheet object reference.
xlSheet.Application.Visible = True
xlSheet.Parent.Windows(1).Visible = True

' If this copy of Microsoft Excel was not running when you
' started, close it using the Application property's Quit method.
' Note that when you try to quit Microsoft Excel, the
' title bar blinks and a message is displayed asking if you
' want to save any loaded files.

If ExcelWasNotRunning = True Then
xlSheet.Application.Quit
End If

Set xlSheet = Nothing ' Release reference to the
' application and spreadsheet.
End Sub

Sub DetectExcel()
' Procedure dectects a running Excel and registers it.
Const WM_USER = 1024
Dim hWnd As Long
' If Excel is running this API call returns its handle.
hWnd = FindWindow(&quot;XLMAIN&quot;, 0)
If hWnd = 0 Then ' 0 means Excel not running.
Exit Sub
Else
' Excel is running so use the SendMessage API
' function to enter it in the Running Object Table.
SendMessage hWnd, WM_USER + 18, 0, 0
End If
End Sub

 

[ald35]

Hey I have a question about how you took data from access and put it in excel...would you mind posting your code for me to take a look at?

Thanks a lot,
Tony

 

[KyleS]

JDU,
I'm sorry, I must not have read over my post weel enough.

Change the line that gives you an error:

objExcel.OpenWorkbooks.Open CurrentPath & &quot;\Weekly Schedule.xls&quot;

To:

objExcel.Workbooks.Open CurrentPath & &quot;\Weekly Schedule.xls&quot; Kyle

 

[JDU]

Thanks for your help, I was able to make this work the way I wanted it to; however, I have a problem that baffles me. Last night I had the following code working as intended on an XP machine. But this morning I can't get the Excel file to open on a 98 and 2000 machine. I did not make any changes to the code from last night to this morning. Here is the code.

Declare Function FindWindow Lib &quot;user32&quot; Alias &quot;FindWindowA&quot; (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib &quot;user32&quot; Alias &quot;SendMessageA&quot; (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Sub GetExcel()
'Dim xlsheet As Object ' Variable to hold reference
' to Microsoft Excel.
Dim ExcelWasNotRunning As Boolean ' Flag for final release.

' Test to see if there is a copy of Microsoft Excel already running.
On Error Resume Next ' Defer error trapping.
' Getobject function called without the first argument returns a
' reference to an instance of the application. If the application isn't
' running, an error occurs.
Set xlsheet = GetObject(, &quot;Excel.Application&quot
If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear ' Clear Err object in case error occurred.

' Check for Microsoft Excel. If Microsoft Excel is running,
' enter it into the Running Object table.
DetectExcel

' Set the object variable to reference the file you want to see.
'Set xlsheet = GetObject(CurrentPath & &quot;\Weekly Schedule.xls&quot

' Show Microsoft Excel through its Application property. Then
' show the actual window containing the file using the Windows
' collection of the xlSheet object reference.
xlsheet.Application.Visible = True
'xlsheet.Parent.Windows(1).Visible = True

With xlsheet
.Workbooks.Open CurrentPath & &quot;\Weekly Schedule.xls&quot;
.Visible = True
End With

' If this copy of Microsoft Excel was not running when you
' started, close it using the Application property's Quit method.
' Note that when you try to quit Microsoft Excel, the
' title bar blinks and a message is displayed asking if you
' want to save any loaded files.

' If ExcelWasNotRunning = True Then
' xlSheet.Application.Quit
' End If
'
' Set xlSheet = Nothing ' Release reference to the
' application and spreadsheet.
End Sub

Sub DetectExcel()
' Procedure dectects a running Excel and registers it.
Const WM_USER = 1024
Dim hWnd As Long
' If Excel is running this API call returns its handle.
hWnd = FindWindow(&quot;XLMAIN&quot;, 0)
If hWnd = 0 Then ' 0 means Excel not running.
Exit Sub
Else
' Excel is running so use the SendMessage API
' function to enter it in the Running Object Table.
SendMessage hWnd, WM_USER + 18, 0, 0
End If
End Sub

 

[TommyF]

You might have already done this but have you checked to make sure you have the same referance files on the 98 and 2000 machines.

Go into Visual Basic and go Tools then References. Check to see if you have the same references ticked, if you have any that say missing untick them as this can cause errors.

 

[JDU]

I am not getting any error messages, just that the Excel file Weekly Schedule does not open.

Thanks.

 

[JDU]

Clarification, I just realized that on the XP Machine I was also using Office XP. On the 98 and 2000 machines I was using Office 2000.

 

[KyleS]

JDU,
I'm going to be honest here, I don't specifically know why 98 and 2000 won't work with your API's. I do know that XP is quite different from 2000 and 98 (2000 and 98 being quite different from each other as well). And work since API are just calls to Windows programming, that's going to make a huge difference.

The code I posted will work with all those systems and won't require the Function declarations or the second Sub to find out if Excel is running... Plus it'll be alot easier to trouble shoot...

Just trying to help. Kyle

 

[JDU]

Kyle,

When trying this code I get the error message 438 Object doesn't support this property or method on line
.Workbooks.Open CurrentPath & &quot;\Weekly Schedule.xls&quot;


Set xlsheet = GetObject(CurrentPath & &quot;\Weekly Schedule.xls&quot

With xlsheet
.Workbooks.Open CurrentPath & &quot;\Weekly Schedule.xls&quot;
.Visible = True
End With

 

[KyleS]

If you use this code here:

Dim objExcel As Object
Set objExcel = CreateObject(&quot;Excel.Application&quot

objExcel.Workbooks.Open CurrentPath & &quot;\Weekly Schedule.xls&quot;

Set xlSheet = objExcel.CurrentWorkbook
Set SchedQuery = CurrentDb.OpenRecordset(&quot;qryWeeklySchedule&quot;, dbOpenDynaset)


It will work. The problem is that in the code you just pasted you've set the xlSheet variable = to the sheet. And the line of code is trying to open that workbook. You can't use a workbook to open a workbook, you need to use an application object, hence the &quot;objExcel&quot; variable. This also lets you make Excel visible (or invisible), and pretty much anything you would want to do with Excel.


Dim objExcel As Object
Set objExcel = CreateObject(&quot;Excel.Application&quot

objExcel.Workbooks.Open CurrentPath & &quot;\Weekly Schedule.xls&quot;

Set xlSheet = objExcel.CurrentWorkbook
Set SchedQuery = CurrentDb.OpenRecordset(&quot;qryWeeklySchedule&quot;, dbOpenDynaset)

SchedQuery.MoveFirst
x = 8

xlSheet.Sheets(1).Activate
With xlSheet.ActiveSheet
.Range(&quot;A8:H47&quot.ClearContents
.Range(&quot;A64:H109&quot.ClearContents

Do While Not SchedQuery.EOF
Select Case x
Case Is = 16
.Cells(x, 1).Value = &quot; &quot;
x = x + 1
Case Is = 18
.Cells(x, 1).Value = &quot;Days&quot;
x = x + 1
Case Is = 38
.Cells(x, 1).Value = &quot;Other&quot;
x = x + 1 Kyle

 

[JDU]

Kyle,
Please Forgive me, I am a novice at VB. I am getting the same error as above, Object doesn't support this property or method on line
Set xlsheet = objExcel.CurrentWorkbook

Thanks

Dim objExcel as Object
Dim xlsheet as object

Set objExcel = CreateObject(&quot;Excel.Application&quot

objExcel.Workbooks.Open CurrentPath & &quot;\Weekly Schedule.xls&quot;

Set xlsheet = objExcel.CurrentWorkbook

With xlsheet
.Visible = True
End With

Set SchedQuery = CurrentDb.OpenRecordset(&quot;qryWeeklySchedule&quot;, dbOpenDynaset)

 

[KyleS]

No apology's needed. We're here to help. I'm the one who should be apologizing. I gave you some code that wasn't 100%...

Well let's fix that

Dim objExcel As Object

Dim xlSheet As Object

Set objExcel = CreateObject(&quot;Excel.Application&quot

objExcel.Workbooks.Open &quot;Y:\Book1.xls&quot;

Set xlSheet = objExcel.ActiveWorkbook

Dim objExcel as Object
Dim xlsheet as object

Set objExcel = CreateObject(&quot;Excel.Application&quot

objExcel.Workbooks.Open CurrentPath & &quot;\Weekly Schedule.xls&quot;

Set xlsheet = objExcel.CurrentWorkbook

With objExcel
.Visible = True
End With

Kyle

 

[originalxavier]

JDU,

Are you trying to open an existing file? You could set up a template xls file that the table will be pasted to, then have the code save as a different file name so that the file will always be there untouched. Let me know if you are interested. Xavier

----------------------------------------
&quot;Programming today is a race between software engineers striving to build bigger and better idiot-proof programs, and the Universe trying to produce bigger and better idiots. So far the Universe is winning.&quot;
Rich Cook
----------------------------------------

 

[JDU]

Hi OriginalXavier,
That's exactly what I am doing. Since I am not a programmer. I sure would like to see your code.

Also Kyle and all the others that helped me Thanks so much.

 

[originalxavier]

Sub Auto_open()
Dim template As String

template = &quot;h:\cccreports\masterfile_template.xls&quot;
Workbooks.Open filename:=template
Windows(&quot;masterfile_template.xls&quot.Activate
Sheets(&quot;rawdataall&quot.Select

With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _...&quot;Enter your query here&quot;
End With

You should not have Auto_open as your Sub name unless you want it to run once the file is opened. Also, be sure to set your security to low (only if you understand what this implies) so that your code will not hang waiting for user input to bypass the Enable/Disable Macros button.

Sheets().select is where you would use the name of the sheet you want to add the data to (Example &quot;Sheet 1&quot.

Once you have entered the data into excel, you will need to do a save as so that you do not overwrite your template with specific data keeping you from using it again.

The following code will save your file as &quot;Call Detail Week Ending 2003-03-07.xls&quot; where the date is one day less than the system date. Then it will close Excel:

Sub Save()
Dim filename As String
Dim savedate As String


'Set the date to save
savedate = Date - 1
savedate = Format(savedate, &quot;yyyy-mm-dd&quot

'Set File Name
filename = &quot;h:\cccreports\data\Call Detail Week Ending &quot; & savedate & &quot;.xls&quot;

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs filename:=filename

Application.Quit

End Sub
In order for this to work, this code has to be in a workbook BY ITSELF. Then create the file that you will be saving data to and keeping as a template. You would enter the file name of the template where &quot;masterfil_template&quot; is noted in the code above.

Let me know if this works... Xavier

----------------------------------------
&quot;Programming today is a race between software engineers striving to build bigger and better idiot-proof programs, and the Universe trying to produce bigger and better idiots. So far the Universe is winning.&quot;
Rich Cook
----------------------------------------