-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
I believe you need to use Automation to open Excel using the GetObject
(if the Excel file is already open) or the CreateObject (if the Excel
file is not open). Here is an example of how to open using Automation
(this is from the Access VBA Help file):
' 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
Dim ExcelWasNotRunning As Boolean
' 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 MyXL = Getobject(, "Excel.Application")
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 MyXL = Getobject("c:\vb4\MYTEST.XLS")
Do manipulations of your file here.
' ...
' If this copy of Microsoft Excel was not running when you
' started, close it using the Application property's Quit method.
If ExcelWasNotRunning = True Then
MyXL.Application.Quit
End IF
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
--
MGFoster:::mgf00 <at> earthlink <decimal-point> net
Oakland, CA (USA)
** Respond only to this newsgroup. I DO NOT respond to emails **
-----BEGIN PGP SIGNATURE-----
Version: PGP for Personal Privacy 5.0
Charset: noconv
iQA/AwUBSULdsoechKqOuFEgEQJzawCgkdcBYq3iiB6x+zkcGEOW8SxCzikAniA3
NtKVz/w40T3ypFsLiECreUgb
=nxjH
-----END PGP SIGNATURE-----
Dim dbs As Database, rst As Recordset
Dim myPath As String
Dim myCount As Variant
Dim myFile As String
Dim SQL As String
Dim wkb As Excel.Workbook
Dim sht As Excel.WorkSheet
Dim xl As Excel.Application
Dim z As Integer
Dim SheetCount As Integer
Dim myRange As String
Dim mySheet As String
Dim c As String
myCount = 0
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("Files")
Set xl = Excel.Application
xl.Visible = False
xl.DisplayAlerts = False
With rst
Do While Not rst.EOF
myCount = myCount + 1
myPath = rst.Fields("FPath")
myFile = rst.Fields("FName")
myRange = "AF70"
Set wkb = xl.Workbooks.Open(myPath & myFile, , False)
For Each sht In ActiveWorkbook.Sheets
If Range("AF70").Value > 0 Then
'SysCmd acSysCmdSetStatus, "Importing " & sht.Name & " from " &
myFile
SQL = "UPDATE MasterTable"
SQL = SQL & " SET F1 = '" & myFile & "'"
SQL = SQL & " WHERE F1 Is Null"
dbs.Execute SQL
SQL = "UPDATE MasterTable"
SQL = SQL & " SET F2 = 1"
SQL = SQL & " WHERE F2 Is Null"
dbs.Execute SQL
End If
Next sht
xl.Workbooks.Close
rst.MoveNext
Loop
rst.Close
Set wkb = Nothing
xl.DisplayAlerts = True
End With
myCount = 0
Set dbs = CurrentDb()
I'm not getting the results I need on this loop. I'm trying to check the
value on each sheet in every workbook, and if that cell on each sheet is >0,
[quoted text clipped - 13 lines]
Show the set up for dbs - from the Dim to the Set. Are you using
Automation (OLE)? I'm assuming this is being run from Excel.
Add dbFailOnError to the Execute command.
