'open the access tool if not already open If Not IsFileOpen(strPath) Then 'IsFileOpen checks and returns true if file is already open depending on strPath (file path) 'close any open access instances Call CloseAllAccess Set oApp = CreateObject("Access.Application") oApp.AutomationSecurity = 1 oApp.OpenCurrentDatabase strPath oApp.Visible = True oApp.DoCmd.OpenTable "tbl_Material" oApp.DoCmd.OpenForm "frmCPanel" Set oApp = Nothing Else Set oApp = CreateObject("Access.Application") oApp.AutomationSecurity = 1 oApp.OpenCurrentDatabase strPath 'i am pretty sure this line shouldn;t be here, but i can;t figure what to put instead oApp.DoCmd.OpenTable "tbl_Material" oApp.DoCmd.OpenForm "frmCPanel" End IfThanks
Dim oWB As Object Dim PWB As String Dim FSS As String PWB = ("c:MyMenuFilesMyMenuiJngo.xls") FSS = "MyMenuiJango.xls" 'First I need to check to see if "MyMenuiJango.xls" is open or not If FileAlreadyOpen("c:MyMenuFilesMyMenuiJango.xls") = True Then ActivateWorkbook (FSS) Application.Quit End Else
Sub OpenMyeMailNo1() Dim oShell Dim sUrl As String sUrl = "http://" & Sheets("Setup").Cells(8, 5).Value Set oShell = CreateObject("Wscript.Shell") oShell.Run (sUrl) End Sub
VB: If IsNumeric(ActiveCell.Value) = True And ActiveCell.Value > 100000 Then SetCurrentDirectoryA prometheus & ActiveCell.Value Application.FindFile MsgBox "Please select a valid job number", vbExclamation + vbOKOnly, "Open Job" Exit Sub End If If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marineswhich looks for a value in the selected cell and, if that value meets the citeria, presents the user with an open file dialogue. This works beautifully until the user choses to open an already open file. At this point Excel says ' this file is already open do you wish to open another copy'. Clicking yes opens a second copy and the macro proceeds but clicking no stops the macro in its tracks. What I would like is to change this code so that after clicking no the macro ends and presents a message box. Even better would be (though more complicated I suspect!) for the macro to test if the file is open first and then either open it and continue or continue using the already open version. Any hints?!
If Not IsFileOpen("testFileFind") Then'This line of code Goes to below FUNCTION - Should NOT
Set oXL = CreateObject("Excel.Application") 'THIS LINE OF CODE MAKES THE NEW INSTANCE OF EXCEL VISIBLE. oXL.Visible = True Set oWB = oXL.Workbooks.Open("c:extrafilesmiscexcelLinkMenu.xls")
End Else MsgBox "File " & "testfilefind" & "is already open." End If'TO HERE - - - - - - - - - - - - - - -
End SubWhen the requested file is already open, the routine should stop here with a message stating that the file is already open.
Function IsFileOpen(FileName As String) Dim iFilenum As Long Dim iErr As Long On Error Resume Next iFilenum = FreeFile() Open FileName For Input Lock Read As #iFilenum Close iFilenum iErr = Err On Error GoTo 0 Select Case iErr Case 0: IsFileOpen = False Case 70: IsFileOpen = True 'ADD THIS Case Else: Error iErr End Select End FunctionI sure hope that someone can understand what I am talking about.
Sub NewExcelWithWorkbook() Dim oXL As Object 'This is needed to open a new instance of Excel. 'Without it, the file is only opened as a new Window Dim OpenFileName '<-this isn't used Dim testFileFind As String Dim oWB As Workbook Dim cl As Range 'This reads the cell 1 column to the Left so the path & file name can be read Set cl = ActiveCell.Offset(0, -1) 'The following tests for a blank cell and ends processing 'It is needed because dir() function will not work with a blank. If Len(Trim(cl)) = 0 Then MsgBox "You have not entered a Path and File name." End End If 'The following tests for the existance of the file testFileFind = Dir(cl) 'If the file is not found there will be nothing in the variable and processing ends. If Len(testFileFind) = 0 Then MsgBox "Invalid selection." & Chr(13) & _ "Filename " & cl.Value & " not found" End End If 'HERE IS MY PROBLEM - - - - - - - - - - - - - - - - - - - - - - - - - - - 'THIS TESTS TO SEE IF THE FILE IS ALREADY OPEN OR NOT If FileAlreadyOpen("cl") = True Then MsgBox "File is already open" End Else End If 'THIS LINE OF CODE OPENS THE NEW INSTANCE OF EXCEL. Set oXL = CreateObject("Excel.Application") 'THIS LINE OF CODE MAKES THE NEW INSTANCE OF EXCEL VISIBLE. oXL.Visible = True Set oWB = oXL.Workbooks.Open(cl) End SubPlease take note: The path and file name constantly change.
Function FileAlreadyOpen(FullFileName As String) As Boolean ' returns True if FullFileName is currently in use by another process ' example: If FileAlreadyOpen("C:FolderNameFileName.xls") Then... Dim f As Integer f = FreeFile On Error Resume Next Open FullFileName For Binary Access Read Write Lock Read Write As #f Close #f ' If an error occurs, the document is currently open. If Err.Number <> 0 Then FileAlreadyOpen = True Err.Clear 'MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description Else FileAlreadyOpen = False End If On Error GoTo 0 End Function
Sub Send_info() Dim wbData As Workbook Dim wbArchive As Workbook Dim WS As Worksheet Set wbData = ActiveWorkbook Set wbArchive = Workbooks.Open("C:abc.xls") For Each WS In wbData.Worksheets WS.Range("A:G").Copy wbArchive.Sheets(WS.Name).Range("A1") Next WS End SubIs there a way I can add to this so that if the file is already open it will just paste the data and ONLY if it is closed it will open the file?