I am using Office 365 on a windows 10 PC.
I have some VBA code in Access to check whether a file is open or locked (the file is local to this PC).
On one computer this code runs for most files, but consistently crashes when it reaches a particular set of files. It is the same set of files each time if I manually step through the code to move on from the first file. I tried rebooting the PC to clear any locks, but the result is the same.
When I say crash, I mean that I loose control of Access and windows reports that it is no longer responding.
If I run the same code on a different PC, referring to the same files, it reports the file is locked, but does not crash.
The file is not locked, or not in the way I understand file locking. From the user interface, I can rename, move or delete the files at will.
I am fairly certain there is nothing wrong with the VBA code as written and am beginning to think there may be a corrupt DLL somewhere.
VBA references
My code crashes at the line Open my_source For Input Lock Read As #ff
Function copyormovemyfiles(my_source As String, my_dest As String, mycontrol As Integer) As Boolean
Dim fso As Scripting.FileSystemObject
Dim ff As Long, ErrNo As Long
''''''''''''''''
' mycontrol = 1 for a move
' mycontrol = 2 for a copy. It will not overwrite files
''''''''''''''''
On Error GoTo error_control
Set fso = New Scripting.FileSystemObject
If Not fso.FileExists(my_source) Then
Err.Raise 1000, , my_source & " does not exist!" & vbExclamation & "Source File Missing"
ElseIf Not fso.FileExists(my_dest) Then
fso.CopyFile my_source, my_dest, True
Else
Err.Raise 1000, my_dest & " already exists!" & vbExclamation
End If
Select Case mycontrol
Case 1
On Error Resume Next
ff = FreeFile()
Open my_source For Input Lock Read As #ff
Close ff
ErrNo = Err
'On Error GoTo 0
If ErrNo > 0 Then Stop
Err.Clear
'Select Case ErrNo
'Case 0: IsWorkBookOpen = False
'Case 70: IsWorkBookOpen = True
'Case Else: Error ErrNo
'End Select
On Error GoTo error_control
It's best to just do an action and then deal with the fail case instead of testing beforehand. The reason is that the state could change between your test and the action. Also, you are raising errors manually when you can just let your code raise it's errors organically.
So you say your copy won't overwrite but then you tell the copy command to overwrite. If we tell it not to overwrite then we no longer have to test if the source or destination exist, they both result in clear errors.
NOTE: Don't use underscore "_" in variable or function names because those are used for event definitions in the VBA event handler.
Function copyormovemyfiles(my_source As String, my_dest As String, mycontrol As Integer) As Boolean
''''''''''''''''
' mycontrol = 1 for a move
' mycontrol = 2 for a copy. It will not overwrite files
''''''''''''''''
On Error GoTo error_control
Dim fso As Scripting.FileSystemObject
fso.CopyFile my_source, my_dest, overwrite:=False
If mycontrol = 1 Then
SetAttr my_source, vbNormal
fso.DeleteFile my_source
End If
copyormovemyfiles = True
error_control:
If Err.Number <> 0 Then
' You can select case here and handle the error
copyormovemyfiles = False
End If
End Function
Related
I have excel vba code that opens different files on makes use of them. An error can occur because there is no file where excel loos for it. I want to create a MsgBox on such errors with a message which specific file is absent.
Now I can only
On Error GoTo ErrorHandler
ErrorHandler:
MsgBox("File is absent")
But I can't specify which exactly file is absent. Is there a way to achieve it through error handler? Maybe through some additional variable?
EDIT: I open files through
Workbooks.Open Filename:=...
But I'm curious about what one should do if the case is
Dim fileTitle As String
filetitle=Dir()
as well.
Rather than hard-coding the file path via:
Workbooks.Open Filename:=...
Use a variable to represent the file path/name:
Dim fileName As String
fileName = "C:/path/to/my/file.xlsx"
Then, check to make sure it exists before you attempt to open it:
If FileIsAccessible(fileName) Then
' Do stuff
Else
MsgBox fileName & " doesn't exist or cannot be opened"
Exit Sub
End If
Use a custom function like
Function FileIsAccessible(path$) As Boolean
Dim FF As Long
On Error GoTo EarlyExit
FF = FreeFile
'Does file exist?
' Raises Error 53 if file not found
Open path For Input Access Read As FF
Close FF
'If file exist, is it accessible?
' Raises error 70 if file is locked/in-use
FF = FreeFile
Open path For Binary Access Write As FF
Close FF
EarlyExit:
FileIsAccessible = (Err.Number = 0)
End Function
You still have access to your variables in error handler, so you know within which file error happen:
Sub ...
Dim filename As String
On Error GoTo ErrorHandler
filename = Dir(...)
While filename>""
Set wb = Workbooks.Open(filename)
...
filename=Dir
Wend
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description & " File: " & filename
End Sub
Two ways to go about this. First, as you suggested, (which is also the easier of the two), you can make a variable that will carry the file name that you reassign after each file successfully loads. That name can then be passed into your message box in the event of a failure. If all you need to do is pass this name, this is the better solution.
The second option would be to create multiple error handlers. I would only recommend this if you need more customization with regard to how the error is handled, like wanting a different message to be displayed based on which type of file was missing. This option would make your code a good bit messier (as you would need to reassign the On Error GoTo ... statement multiple times, but its worth considering if you need a more complex solution.
Give this a try and tweak it as per your requirement. This will give you a starting point to deal with error handling....
Assuming you are trying to open a file abc.xlsx which is located at your Desktop and if this file isn't found on Desktop, the error handling will be triggered.
Don't forget to use Exit Sub before Error Handling label so that it is not executed if the file was found.
Dim wb As Workbook
Dim FilePath As String
FilePath = Environ("UserProfile") & "\Desktop\abc.xlsx"
On Error GoTo ErrorHandler
Set wb = Workbooks.Open(FilePath)
'Other stuff here if file was found and opened successfully
'
'
'
'
Exit Sub
ErrorHandler:
MsgBox Err.Number & vbNewLine & Err.Description, vbCritical, "File Not Found!"
I am checking if a file is open or not that is a .txt file
Private Sub CommandButton1_Click()
Dim strFileName As String
' Full path and name of file.
strFileName = "D:\te.txt"
' Call function to test file lock.
If Not FileLocked(strFileName) Then
' If the function returns False, open the document.
MsgBox "not open"
Else
MsgBox "open"
End If
End Sub
Function FileLocked(strFileName As String) As Boolean
On Error Resume Next
' If the file is already opened by another process,
' and the specified type of access is not allowed,
' the Open operation fails and an error occurs.
Open strFileName For Binary Access Read Write Lock Read Write As #1
Close #1
' If an error occurs, the document is currently open.
If Err.Number <> 0 Then
' Display the error number and description.
MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
FileLocked = True
Err.Clear
End If
End Function
It turns out .txt when opened using notepad doesn't lock the file, so it can not be known if a .txt file is open or not. And hence, if that .txt file is opened in Wordpad or Sakura, etc., your code should work or at least other code from the net should work.
I found that if a text file is opened using FileSystemObject, then the file is not locked and can still be edited by other users. As a potential workaround, you could make a file with a single bit to indicate when the other file is in use, and include checking that bit in your code. Here's my code as a rough example:
'FSO parameters
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2
Sub WriteToFile()
Set fso = CreateObject("Scripting.FileSystemObject")
'Check the current lock bit (1 is locked, 0 is unlocked)
Set FileLock = fso.OpenTextFile("C:\FileLock.txt", ForReading)
Dim LockBit As Integer
LockBit = FileLock.ReadAll
FileLock.Close
'If the bit is 1 (file in use) then wait 1 second and try again (up to 10 times)
For try = 1 To 10
If LockBit = 1 Then
Application.Wait (Now + TimeValue("0:00:1"))
Set FileLock = fso.OpenTextFile("C:\FileLock.txt", ForReading)
LockBit = FileLock.ReadAll
FileLock.Close
Else: GoTo Line1 'when the bit is 0 (file available)
End If
If try = 10 Then
MsgBox "File not available"
Exit Sub
End If
Next try
Line1:
Call LockTheFile(fso, True) 'Change the lock bit to "1" to show the file's in use
Set WriteFile = fso.OpenTextFile("C:\WriteFile.txt", ForWriting)
'Do what you will with the file
MsgBox "Write Successful"
WriteFile.Close
Call LockTheFile(fso, False) 'Change the lock bit to "0" to show the file's available
End Sub
I made this sub separate to make the main code more streamlined
Sub LockTheFile(fso, SetLock As Boolean)
'Write "1" to a lock file to indicate the text file is in use, or "0" to indicate not in use
Set BitFile = fso.CreateTextFile("C:\FileLock.txt", True)
If SetLock = True Then
BitFile.WriteLine "1"
Else
BitFile.WriteLine "0"
End If
BitFile.Close
End Sub
To start off I have a function in VBA Excel that tells me if a Word Document is open or not open. For testing purposes I don't have the Word Document Open and expect 'False' to be returned.
Function IsFileOpen(filename As String) As Boolean
Dim filenum As Integer, errnum As Integer
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnum
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Error errnum
End Select
End Function
Called Via:
...
If IsFileOpen("C:/Temp/test.docx") = True Then
MsgBox objWord.ActiveDocument.Name & " already open" 'ERROR FROM PIC HERE
Set objDoc = objWord.ActiveDocument
Else
Set objDoc = objWord.Documents.Open("C:/Temp/test.docx", Visible:=True)
End If
...
However when running the code I get that the Document is open (Returned True from the IsFileOpen function from case 70) yet I get an error on 'objWord.ActiveDocument.Name' that no Document is Open
On Windows 7 Task Manager this is what I have. Word Application is closed but it appears there are background processes open of Word. However I close all documents I don't use so these processes shouldn't be running
I think a better test to check to see if your Word File is open is to use the actual Word Documents collection
So for your example, use something like this:
With objWord
For Each doc In .Documents
If doc.Name = "test.docx" Then
found = True
Exit For
End If
Next doc
If found <> True Then
.Documents.Open FileName:="C:/Temp/test.docx"
Else
.Documents("test.docx").Activate
End If
End With
I wanted to use shared excel workbooks on server which would be variously connected to each other.
I worked on it for many days to only find out it has many problems to cope with as shared workbooks do not support many features.
I wanted the macro to check on opening the file to find out whether the file is opened by someone else and if "yes", it would tell the person to come back later.
Unfortunately, I am now referencing to myself and this creates a loop.
I open the file, it checks itself it is opened already and then after the message it closes.
Could you please help me to evade the loop so it would suit the purpose?
I believe only the upper part of the code relates to my problem, so I do not post it in full:
Option Explicit
Private Sub Workbook_Open()
Dim Ret
Ret = IsWorkBookOpen(ThisWorkbook.FullName)
If Ret = True Then
MsgBox "Come back later."
ThisWorkbook.Close savechanges:=False
End If
End Sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
I don't think you need to use that function for your purpose.
You can actually check the status of the file using:
ThisWorkbook.ReadOnly
which returns a boolean; true if file is readonly.
Now, before opening the file you really cannot suppress the pop up asking if you want to open it as read only or not. But you can still try putting this code which will trigger once the user opened the file as read only.
Private Sub Workbook_Open()
If ThisWorkbook.ReadOnly Then
MsgBox "Comeback some other time. File in use"
ThisWorkbook.Close False
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Quit
End Sub
The beauty of the IsWorkBookOpen approach is the speed compared to opening the workbook over a network compared to a ReadOnly test.
I would recommend you change your approach to load the check from a vbs, or a separate Excel file - as this is the best method.
The code below can be save in NotePad on your network drive as a vbs, say check.vbs. The code checks if the file is open, if not then it launches the file in a new instance of Excel. If it is, a message is provided.
vbs code
Dim objExcel
FileName = "C:\temp\file.xlsm"
If Not IsWorkBookOpen(FileName) Then
Set objExcel = CreateObject("Excel.Application")
Set ojbWb = objExcel.Workbooks.Open(FileName)
objExcel.Visible = True
Else
wscript.echo FileName & " already opened"
End If
Function IsWorkBookOpen(FileName)
Set oFSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set objFile = oFSO.OpenTextFile(filename, 8, False)
ErrNo = Err
ObjFile.Close
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
set objFSO = Nothing
End Function
If you want to run the check from the actual file then you will need to change to the ReadOnly test
code
Private Sub Workbook_Open()
If Me.ReadOnly Then MsgBox "file already opened", vbCritical
End Sub
I post this as I have seen this question unanswered on other forums, too.
I wanted to use many shared excel workbooks on server which would be variously connected to each other.
I wanted to use the so called shared workbook so everyone could access it and especially for the reason that it would track the changes within (users, time,...)
I wanted the macro to check on opening the file to find out whether the file is opened by someone else and if "yes", it would tell the person to come back later.
Suggested replies here could not help and I believe there is no chance to create a macro for path of the file itself so that IsWorkBookOpen(ThisWorkbook.FullName)
could be used the way I tried.
I decided to write macro that would track changes within the Workbook as if it was "shared". This way I was able to "unshare" it and use the ReadOnly approach discussed here.
Hi I'm using a code to verify if a workbook is open and if it is I message the user to close the workbook. This is for an MS ACCESS Form. My current code is as follows:
Option Explicit
Sub Sample()
Dim Ret
Dim strPath as string
strpath = "C:\myWork.xlsx"
Ret = IsWorkBookOpen(strpath)
If Ret = True Then
MsgBox "File is open"
Else
MsgBox "File is Closed"
End If
End Sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
I use it in different forms and the Directory changes depending on where the user wants it. It sometimes work but most of the time I get a Run Time Error. When I verify the Err variable it's alaway Err = 53 if its open or not. Sometimes Err = 70 or Err = 0 and the code runs smoothly but it is never the case.
Error #53 is File Not Found.
This site has code that does exactly what you're trying to do:
http://accessexperts.com/blog/2012/03/06/checking-if-files-are-locked/
The error you are getting means "file not found" (you can use Err.Description to get something more informative than "53"). Maybe there is a problem with the name, or the path, or some stray characters crept in... Or maybe it has to do with the way you generated the names in the first place. See http://www.excelforum.com/excel-programming-vba-macros/727403-runtime-error-53-file-not-found.html for a possible scenario and workaround. Without more information about the file name you passed to your routine when it failed it is hard to be more specific.
I was having the exact same problem. In my case, I was able to fix the issue when I realized I was sending the IsWorkbookOpen Function just the name of the file, but without the path. When I modified my initial code to send the file an argument in the form of a string that contained both the path and the filename, concatenated together, it worked.