confirmation of file before opening spreadsheet

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I want to write code in the Worksheet so that when users open the
spreadsheet it looks for and confirms that a file with a certain name
exists in the Windows directory. Otherwise it closes the spreadsheet.
Does anyone know how to do this?
your help will be appreciated

phil in da uk
 
This is a bit overkill for what you are asking but it is a standard module
that I use to run code differently based on the existence of different files.
You will need to strip out the error handling code but otherwise it should be
good to go...

Option Explicit
'***********************************************************************************************
'Jim Thomlinson
'June 3, 2004
'modFPA module
'This module changes the functionality of the spreadsheet based on whether
the user is in the
'FPA group or not.
'***********************************************************************************************

'Declare Module Level Constants
Private Const m_cModule As String = "modFPA" 'Used by
ErrorHandler
Private Const m_cFPADirectory As String = "C:\FPA\" 'Directory of
FPA file
Private Const m_cFPAFile As String = "FPA.RUN" 'Name of file to
indicate FPA Group
Private Const m_cAutoRunFile As String = "AUTORUN.RUN" 'Name of file to
indicate AutoRun

'***********************************************************************************************
'Name: auto_open
'Inputs: None
'Outputs: Defines the parameters under which the spreadsheet will run.
'Side Effects: None
'Calls: None
'Description: Based on whether the procedure fines the file indicated by
m_cFPADirectory and
' m_cFPAFile, it initializes the spreadsheet to work
approprite for the user.
'***********************************************************************************************
Public Sub auto_open()
On Error GoTo ErrorHandler

'Initialize Application
Application.ScreenUpdating = False

Call AlwaysExecute

'Determine if the FPA file exists on the system
If UCase(Dir(m_cFPADirectory & m_cFPAFile)) = m_cFPAFile Then
'The file exists so initialize for FPA user
Call InitializeApplicationFPA
ElseIf UCase(Dir(m_cFPADirectory & m_cAutoRunFile)) = m_cAutoRunFile Then
'The file exists so initialize for AutoRun
Call InitializeApplicationAutoRun
Else
'The file does not exist so initialize for Non FPA user
Call InitializeApplicationNonFPA
End If

Application.ScreenUpdating = True
Exit Sub

ErrorHandler:
modErrors.HandleError m_cModule, "auto_open"
End Sub

'***********************************************************************************************
'Name: InitializeApplicationFPA
'Inputs: None
'Outputs:
'Side Effects: None
'Calls: None
'Description:
'***********************************************************************************************
Private Sub InitializeApplicationFPA()
On Error GoTo ErrorHandler
'Add Code Here
Exit Sub

ErrorHandler:
modErrors.HandleError m_cModule, "InitializeApplicationFPA"
End Sub

'***********************************************************************************************
'Name: InitializeApplicationAutoRun
'Inputs: None
'Outputs:
'Side Effects: None
'Calls: None
'Description:
'***********************************************************************************************
Private Sub InitializeApplicationAutoRun()
On Error GoTo ErrorHandler
'Add Code Here
Application.ActiveWorkbook.Close SaveChanges:=True
Exit Sub

ErrorHandler:
modErrors.HandleError m_cModule, "InitializeApplicationAutoRun"
End Sub

'***********************************************************************************************
'Name: InitializeApplicationNonFPA
'Inputs: None
'Outputs:
'Side Effects: None
'Calls: None
'Description:
'***********************************************************************************************
Private Sub InitializeApplicationNonFPA()
On Error GoTo ErrorHandler
'Add Code Here
Exit Sub

ErrorHandler:
modErrors.HandleError m_cModule, "InitializeApplicationNonFPA"
End Sub

'***********************************************************************************************
'Name: AlwaysExecute
'Inputs: None
'Outputs:
'Side Effects: None
'Calls: None
'Description:
'***********************************************************************************************
Private Sub AlwaysExecute()
On Error GoTo ErrorHandler
'Add Code Here
Exit Sub

ErrorHandler:
modErrors.HandleError m_cModule, "AlwaysExecute"
End Sub

'***********************************************************************************************
'Name: auto_close
'Inputs: None
'Outputs: Defines the parameters under which the spreadsheet will exit.
'Side Effects: None
'Calls: None
'Description: Based on whether the procedure fines the file indicated by
m_cFPADirectory and
' m_cFPAFile, it ends the spreadsheet to work approprite for
the user.
'***********************************************************************************************
Public Sub auto_close()
On Error GoTo ErrorHandler

'Initialize Application
Application.ScreenUpdating = False

'Determine if the FPA file exists on the system
If UCase(Dir(m_cFPADirectory & m_cFPAFile)) = m_cFPAFile Then
'The file exists so End for FPA user
Call EndApplicationFPA
ElseIf UCase(Dir(m_cFPADirectory & m_cAutoRunFile)) = m_cAutoRunFile Then
'The file exists so End for AutoRun
Call EndApplicationAutoRun
Else
'The file does not exist so end for Non FPA user
Call EndApplicationNonFPA
End If

Application.ScreenUpdating = True
Exit Sub

ErrorHandler:
modErrors.HandleError m_cModule, "auto_close"
End Sub


'***********************************************************************************************
'Name: EndApplicationFPA
'Inputs: None
'Outputs:
'Side Effects: None
'Calls: None
'Description:
'***********************************************************************************************
Private Sub EndApplicationFPA()
On Error GoTo ErrorHandler

Exit Sub

ErrorHandler:
modErrors.HandleError m_cModule, "EndApplicationFPA"
End Sub

'***********************************************************************************************
'Name: EndApplicationAutoRun
'Inputs: None
'Outputs:
'Side Effects: None
'Calls: None
'Description:
'***********************************************************************************************
Private Sub EndApplicationAutoRun()
On Error GoTo ErrorHandler

Exit Sub

ErrorHandler:
modErrors.HandleError m_cModule, "EndApplicationAutoRun"
End Sub

'***********************************************************************************************
'Name: EndApplicationNonFPA
'Inputs: None
'Outputs:
'Side Effects: None
'Calls: None
'Description:
'***********************************************************************************************
Private Sub EndApplicationNonFPA()
On Error GoTo ErrorHandler

Exit Sub

ErrorHandler:
modErrors.HandleError m_cModule, "EndApplicationNonFPA"
End Sub


HTH
 
Hi,

This is a modification of Tom Olgive's code found by searching the Google
group.
If the workbook is not open it will open it and then activate your
spreadsheet.
You need to change some info to suit your needs.


Sub chectforworkbook()
Dim wkbk As Workbook
Dim sName As String
sName = "Integrity.xls"
On Error Resume Next
Set wkbk = Workbooks(sName)
On Error GoTo 0
If wkbk Is Nothing Then
Set wkbk = Workbooks.Open(sName)
Windows("Book2").Activate
End If
End Sub
 
Thanks for trying to help me with this but I don't know how to use this code
Below is the worksheet (open) code - I need to insert something in here (in
the right
place) so that we get confirmation of a file called 'hyperlink.twd' in
windows
sys32, or else the workbook quits.
Thanks for your patience

Private Sub Workbook_Open()
Worksheets.Select
Columns("A:M").Select
ActiveWindow.Zoom = True
ActiveSheet.ScrollArea = "A1:M30"
Range("A1").Select
Application.CommandBars.ActiveMenuBar.Enabled = False
Application.DisplayFullScreen = True
Application.CommandBars("Full Screen").Enabled = False
Dim NumberofTBs As Integer
Dim TBC As Integer
Let NumberofTBs = Toolbars.Count
For TBC = 1 To NumberofTBs
Toolbars(TBC).Visible = False
Next TBC
For TBC = 2 To 18
Application.CommandBars(TBC).Visible = False
Application.DisplayStatusBar = False
Application.DisplayFormulaBar = False
Next TBC
Application.Run "TMR.xls!Macro74"
Application.Run "TMR.xls!Macro76"

Sheets("MENU").Select

If ActiveWorkbook.FullName = "C:\TMR\TMR.xls" Then
Sheets("MENU").Select
Else
Sheets("End").Select
Range("A1").Select
MsgBox "Contact Psyfactor Ltd for Licence", vbOKOnly, "TMR"
Application.ActiveWorkbook.Save
Application.QUIT


End If

End Sub
 
Thanks for trying to help, but I haven't explained it properly.
I'm attaching the code below. When the workbook (TMR) opens, I want it
to close again, unless the file 'hyperlink.twd' is found in Windows sys32.
thanks for your patience
here is the code

Private Sub Workbook_Open()
Worksheets.Select
Columns("A:M").Select
ActiveWindow.Zoom = True
ActiveSheet.ScrollArea = "A1:M30"
Range("A1").Select
Application.CommandBars.ActiveMenuBar.Enabled = False
Application.DisplayFullScreen = True
Application.CommandBars("Full Screen").Enabled = False
Dim NumberofTBs As Integer
Dim TBC As Integer
Let NumberofTBs = Toolbars.Count
For TBC = 1 To NumberofTBs
Toolbars(TBC).Visible = False
Next TBC
For TBC = 2 To 18
Application.CommandBars(TBC).Visible = False
Application.DisplayStatusBar = False
Application.DisplayFormulaBar = False
Next TBC
Application.Run "TMR.xls!Macro74"
Application.Run "TMR.xls!Macro76"

Sheets("MENU").Select

If ActiveWorkbook.FullName = "C:\TMR\TMR.xls" Then
Sheets("MENU").Select
Else
Sheets("End").Select
Range("A1").Select
MsgBox "Contact Psyfactor Ltd for Licence", vbOKOnly, "TMR"
Application.ActiveWorkbook.Save
Application.QUIT


End If

End Sub
 
Phil,

Not sure if this is what you want but I changed some of your code to check
for hyperfile.twd and if it does not exist then the workbook should close.
Not tested.

Charles

phil said:
Thanks for trying to help, but I haven't explained it properly.
I'm attaching the code below. When the workbook (TMR) opens, I want it
to close again, unless the file 'hyperlink.twd' is found in Windows sys32.
thanks for your patience
here is the code

Private Sub Workbook_Open()
Worksheets.Select
Columns("A:M").Select
ActiveWindow.Zoom = True
ActiveSheet.ScrollArea = "A1:M30"
Range("A1").Select
Application.CommandBars.ActiveMenuBar.Enabled = False
Application.DisplayFullScreen = True
Application.CommandBars("Full Screen").Enabled = False
Dim NumberofTBs As Integer
Dim TBC As Integer
Let NumberofTBs = Toolbars.Count
For TBC = 1 To NumberofTBs
Toolbars(TBC).Visible = False
Next TBC
For TBC = 2 To 18
Application.CommandBars(TBC).Visible = False
Application.DisplayStatusBar = False
Application.DisplayFormulaBar = False
Next TBC
Application.Run "TMR.xls!Macro74"
Application.Run "TMR.xls!Macro76"

Sheets("MENU").Select
Click to expand...
On Error Resume Next
ChDir "C:\hyperlink.twd"
If Err = "76" Then
MsgBox "File : " & "Hyperlink.twd" & " Does not exist"
Sheets("End").Select
Range("A1").Select
MsgBox "Contact Psyfactor Ltd for Licence", vbOKOnly, "TMR"
Application.ActiveWorkbook.Save
Application.QUIT
else
If ActiveWorkbook.FullName = "C:\TMR\TMR.xls" Then
Sheets("MENU").Select

End If
 
Charles, thanks for this.
I

Charles Harmon said:
Phil,

Not sure if this is what you want but I changed some of your code to check
for hyperfile.twd and if it does not exist then the workbook should close.
Not tested.

Charles


On Error Resume Next
ChDir "C:\hyperlink.twd"
If Err = "76" Then
MsgBox "File : " & "Hyperlink.twd" & " Does not exist"
Sheets("End").Select
Range("A1").Select
MsgBox "Contact Psyfactor Ltd for Licence", vbOKOnly, "TMR"
Application.ActiveWorkbook.Save
Application.QUIT
else
If ActiveWorkbook.FullName = "C:\TMR\TMR.xls" Then
Sheets("MENU").Select

End If
Click to expand...
 
You must log in or register to reply here.

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

Excel Excel spreadsheets opening at top instead of bottom. 4
Confirmation of file 2
Spreadsheet autorun macro, parameter? 3
Excel 2003 VBA In directory Open Spreadsheets Extract data 1
Accurately reading the contents of another spreadsheet 6
How check if file to open is Excel or if Excel file is corrupt? 3
Copying Data between Spreadsheets based on a rows value 1
Opening an Excel spreadsheet from within an Excel spreadsheet 2

Back
Top