Re: Opening Excel from Access

On May 25, 2:01 pm, "Phil Stanton" <p...@xxxxxxxxxxxxxxxxxx> wrote:
Thanks for coming back

Code is:-
Function GetAccess()
'
' Macro1 Macro
' Macro recorded 26/03/2008 by Phil Stanton
'
    Dim MDBName As String, DefaultDirectory As String, SQLStg As String

    On Error GoTo GetAccess_Err

    Worksheets("Linked Data").Activate
    With Active***
        MDBName = .Range("A1")

CheckFile:
        If Dir(MDBName) = "" Then                  ' Not found
            MDBName = Application.GetOpenFileName("Access Database ,*.mde",
, "Where is the Club Database?")
            If MsgBox("Do you want to use this database in future?",
vbQuestion + vbYesNo) = vbYes Then
                .Range("A1") = MDBName
            End If
        End If
    End With

'
    ' Clear Cells

    Active***.Range("A2:H300").Clear

    SQLStg = "SELECT DISTINCT TypeOfSpace, Space, SpaceAndName, XPos, YPos,
XLabelPosition, YLabelPosition, LabelAngle "
    SQLStg = SQLStg & "FROM `" & MDBName & "`."         ' Note the ` symbol.
Significant

    DefaultDirectory = Left(MDBName, InStrRev(MDBName, "\"))

    'DBName = "C:\WFYC Data\Phil's Folder\Access\MDB\Clubs New 2007"
            '"ODBC;DSN=MS Access Database;DBQ=" & MDBName &
";DefaultDir=C:\WFYC Data\Phil's Folder\Acces"
    With Active***.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DSN=MS Access Database;DBQ=" & MDBName & ";DefaultDir=" &
DefaultDirectory _
        ), Array("s\MDB;DriverId=25;FIL=MS
Access;MaxBufferSize=2048;PageTimeout=5;")), _
        Destination:=Range("A2"))
        .CommandText = Array(SQLStg, "QSpaceAllocation QSpaceAllocation
ORDER BY TypeOfSpace, Space")
        .Name = "Query from MS Access Database"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=True
    End With

    'Stop                ' Has it got here?

    Exit Function

GetAccess_Err:
Stop
    If Err = 1234 Then                            ' No Idea what the error
code will be
        ThisWorkbook.Close , False
    Else
        MsgBox Err.Description
    End If

End Function

There is a lot of other code, but this is the bit where the data is
"extracted" from Access.
As I said, no problem whether the Access DB is open or not, the problem
comes when I click the button on Access form to show the Excel file.
The "Linked Data" work*** holds and processes the data, and the output is
11 labelled scatter charts, one on each page (Map of boat compound and where
each boat is stored)

Thanks again

Phil

"ByteMyzer" <bNyOtSePmAyMzN...@xxxxxxxxxxxxx> wrote in message

news:qqi_j.684$iM3.561@xxxxxxxxxxxxxxxxxxxxxxx



Please post the code that is in the Excel file.  If that code refers to
the
database, then that is most likely where the error is occuring, in which
case, we might be better able to help you.

"Phil Stanton" <p...@xxxxxxxxxxxxxxxxxx> wrote in message
news:R8idnaH_C8VIEaTVnZ2dnUVZ8tPinZ2d@xxxxxxxxxxxxxxxxx
Sorry

Should have added

There is some code in the Excel application which refers to the Database
and
extracts the relevant information

No problem opening Excel whether the database is open or not.

Phil

"Phil Stanton" <p...@xxxxxxxxxxxxxxxxxx> wrote in message
news:W82dnW2MNIyg8aTVnZ2dnUVZ8tfinZ2d@xxxxxxxxxxxxxxxxx
I have a form with a button which is supposed to open an Excel file
(With
lots of Macros /VBA) in it. The Excel file gets it's data from the
Access
program

Here is the code

Private Sub Storage_Click()

   On Error GoTo Err_Storage_Click

   Dim ExcelApp As Object
   Dim ExcelWasNotRunning As Boolean           ' Flag for final release
   Dim XLFilePath As String
   Dim XLName As String                        ' Excel file name from
Paths
   Dim MyDb As Database
   Dim Msg As String

   ' Find the normal path
                                         ' Folder and File
   If Nz(ExcelPath) = "" Then
       ExcelPath = "C:\Storage.XLS"
   End If

   XLName = Right(ExcelPath, Len(ExcelPath) - InStrRev(ExcelPath, "\"))
'
File Name

   If Dir(ExcelPath) <> XLName Then          ' Not found
       XLFilePath = FindFile("C:\Documents and Settings\Phil\My
Documents\Access\MDB\WFYC\", XLName)
       Msg = "The name of the file you have selected is " & vbCrLf
       Msg = Msg & XLFilePath & vbCrLf
       Msg = Msg & "but the original file was " & vbCrLf
       Msg = Msg & ExcelPath & vbCrLf
       Msg = Msg & "Do you want to use the new name in future?"
       If MsgBox(Msg, vbQuestion + vbYesNo) = vbYes Then
           ExcelPath = XLFilePath
       End If
   End If

   Set ExcelApp = CreateObject("Excel.Application")

   If Err.Number <> 0 Then ExcelWasNotRunning = True
   Err.Clear    ' Clear Err object in case error occurred.

   ' Set the object variable to reference the file you want to see.

   Set ExcelApp = CreateObject("Excel.Application")
   ExcelApp.WorkBooks.Open ExcelPath, , True                   ' Read
Only
   ExcelApp.Visible = True

Exit_Storage_Click:
   Exit Sub

Err_Storage_Click:
   If Err = 2447 Then              ' Corrupted File name (with # sign)
       Resume Next
   Else
       MsgBox Err.Description
       Resume Exit_Storage_Click
   End If

End Sub

When I run it, I get an Error Box "ODBC Microsoft Access Driver Login
Failed" and the message "The database has been placed in a state by
user
'Admin' on Machine 'PHIL-DESKTOP' that prevents it being opened or
locked"

What am I doing wrong

Thank

Phil- Hide quoted text -

- Show quoted text -

what's the name of the table being selected in the mdbname ?
SQLStg = "SELECT DISTINCT TypeOfSpace, Space, SpaceAndName, XPos,
YPos,
XLabelPosition, YLabelPosition, LabelAngle "
SQLStg = SQLStg & "FROM `" & MDBName & "`." ' Note the `
symbol.
Significant

.