A
Alex
Hi everybody,
I need to transfer data from Access to Excel and in Excel
some range name should be assigned at that time. (Without
this range name assignment we could use just
DoCmd.OutputTo ...
and everything would be fine.) But, with this I'm using
such a complicated thing, which I put below and which I've
got from Access help file. The problem there is that I
should make Excel file temporary visible for a user, which
can be bothering. But, without this it's getting to be
corrupted somehow, cannot be opened - opened with empty
Excel frame.
I would appreciate if anybody could advise something.
Sorry, for so long posting.
Thanks advance,
Alex
Function Item_Price()
On Error GoTo Item_Price_Err
''''''''''''''''''''''''''Set xl = CreateObject
("Excel.Application")''''''''''''''''''
Dim ref As Reference
Dim MyXL As Object ' Variable to hold reference
' to Microsoft Excel.
Dim ExcelWasNotRunning As Boolean ' Flag for final
release.
Dim Msg
' 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. Note the comma used as the
first argument
' placeholder.
Set ref = References!Excel
Set MyXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear ' Clear Err object in case error occurred.
' Check for Excel. If Excel is running,
' enter it into the Running Object table.
DetectExcel
DoCmd.OutputTo acOutputQuery, _
"Ingredient Specs",
acFormatXLS, "S:\Operations\Products\Recipes\Ingredient
Specs.xls" '"Item_Cost"
' Set the object variable to reference the file you want
to see.
Set MyXL = GetObject
("S:\Operations\Products\Recipes\Ingredient
Specs.xls") '"C:\Test2.xls"
' Show Microsoft Excel through its Application property.
Then
' show the actual window containing the file using the
Windows
' collection of the MyXL object reference.
MyXL.Application.Visible = True ''''''''
MyXL.Parent.Windows(1).Visible = True '''''''''
' Assign a range name
MyXL.Application.Worksheets("Ingredient Specs").Range
("A1:H400").Name = "d" 'Item_Cost
' If this copy of Microsoft Excel was not already running
when you
' started, close it using the Application property's Quit
method.
' Note that when you try to quit Microsoft Excel, the
Microsoft Excel
' title bar blinks and Microsoft Excel displays a message
asking if you
' want to save any loaded files.
If ExcelWasNotRunning = True Then
MyXL.Save
MyXL.Application.Quit
Else
MyXL.Save
MyXL.Application.Quit
End If
Set MyXL = Nothing ' Release reference to the
' application and spreadsheet.
Msg = MsgBox("All prices in Recipes have been updated
successfully!", _
vbExclamation, "Recipes Price Update")
Item_Price_exit:
Exit Function
Item_Price_Err:
MsgBox Error
Resume Item_Price_exit
End Function
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("XLMAIN", 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
<<<This is in module:>>>
Option Compare Database
' 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
I need to transfer data from Access to Excel and in Excel
some range name should be assigned at that time. (Without
this range name assignment we could use just
DoCmd.OutputTo ...
and everything would be fine.) But, with this I'm using
such a complicated thing, which I put below and which I've
got from Access help file. The problem there is that I
should make Excel file temporary visible for a user, which
can be bothering. But, without this it's getting to be
corrupted somehow, cannot be opened - opened with empty
Excel frame.
I would appreciate if anybody could advise something.
Sorry, for so long posting.
Thanks advance,
Alex
Function Item_Price()
On Error GoTo Item_Price_Err
''''''''''''''''''''''''''Set xl = CreateObject
("Excel.Application")''''''''''''''''''
Dim ref As Reference
Dim MyXL As Object ' Variable to hold reference
' to Microsoft Excel.
Dim ExcelWasNotRunning As Boolean ' Flag for final
release.
Dim Msg
' 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. Note the comma used as the
first argument
' placeholder.
Set ref = References!Excel
Set MyXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear ' Clear Err object in case error occurred.
' Check for Excel. If Excel is running,
' enter it into the Running Object table.
DetectExcel
DoCmd.OutputTo acOutputQuery, _
"Ingredient Specs",
acFormatXLS, "S:\Operations\Products\Recipes\Ingredient
Specs.xls" '"Item_Cost"
' Set the object variable to reference the file you want
to see.
Set MyXL = GetObject
("S:\Operations\Products\Recipes\Ingredient
Specs.xls") '"C:\Test2.xls"
' Show Microsoft Excel through its Application property.
Then
' show the actual window containing the file using the
Windows
' collection of the MyXL object reference.
MyXL.Application.Visible = True ''''''''
MyXL.Parent.Windows(1).Visible = True '''''''''
' Assign a range name
MyXL.Application.Worksheets("Ingredient Specs").Range
("A1:H400").Name = "d" 'Item_Cost
' If this copy of Microsoft Excel was not already running
when you
' started, close it using the Application property's Quit
method.
' Note that when you try to quit Microsoft Excel, the
Microsoft Excel
' title bar blinks and Microsoft Excel displays a message
asking if you
' want to save any loaded files.
If ExcelWasNotRunning = True Then
MyXL.Save
MyXL.Application.Quit
Else
MyXL.Save
MyXL.Application.Quit
End If
Set MyXL = Nothing ' Release reference to the
' application and spreadsheet.
Msg = MsgBox("All prices in Recipes have been updated
successfully!", _
vbExclamation, "Recipes Price Update")
Item_Price_exit:
Exit Function
Item_Price_Err:
MsgBox Error
Resume Item_Price_exit
End Function
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("XLMAIN", 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
<<<This is in module:>>>
Option Compare Database
' 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