I cannot seem to get a definite feedback on whether or not a read-only workbook is opened or not. In my code I have it copy after closing/saving the workbook. I would like to be able to overwrite the read-only workbook if it's opened as read-only by another user. I tried this something like this bit of code, but had no luck, it just kept saying "File not open!" even when I had it opened.
How can I check whether or not a "read-only .xlsx" file is opened or not in vba?
Sub Test_If_File_Is_Open_2()
Dim wBook As Workbook
On Error Resume Next
Set wBook = Workbooks("C:\Users\" & Environ("username") & "\Documents\Dropbox\Systems\Open Machine Schedule\Open Machine Schedule.xlsx")
If wBook Is Nothing Then 'Not open
MsgBox "File is Not open!"
Else 'It is open
MsgBox "File is Open!" 'Never get this to display when I have the excel file open
End If
End Sub
What started the prompt for using this bit of code(above) was because I wanted the macro to not cause an error if the read-only workbook was opened by another user. When I run the macro below and have the copied read-only workbook opened prior, I get an error:"vba run time error 1004 cannot access read-only document"
I don't get this error when the copied workbook is closed, it overwrites it like it's supposed to.
Here is the code that prompted this question:
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim backupfolder As String
backupfolder = "C:\Users\" & Environ("username") & "\Documents\Dropbox\Systems\Open Machine Schedule\"
ThisWorkbook.SaveAs Filename:=backupfolder & "Open Machine Schedule - Current.xlsx", FileFormat:=xlOpenXMLWorkbook
End Sub
Sub Auto_Save()
Dim savedate
savedate = Date
Dim savetime
savetime = Time
Dim formattime As String
formattime = Format(savetime, "hh.MM.ss")
Dim formatdate As String
formatdate = Format(savedate, "DD - MM - YYYY")
Application.DisplayAlerts = False
Dim backupfolder As String
backupfolder = "C:\Users\" & Environ("username") & "\Documents\Dropbox\Systems\Open Machine Schedule\"
ActiveWorkbook.Save
ActiveWorkbook.SaveAs backupfolder & "Open Machine Schedule - Current.xlsx", FileFormat:=xlOpenXMLWorkbook
SetAttr backupfolder & "Open Machine Schedule - Current.xlsx", vbReadOnly
Application.DisplayAlerts = True
MsgBox "Backup Run. Please Check at: " & backupfolder & " !"
End Sub
Any help/suggestions would be much appreciated
your first code is only testing to see if a workbook exist not its state.
You could use this instead:
If wBook.ReadOnly Then
MsgBox "File is Read-only"
Else
MsgBox "File is not read-only"
End If
Related
I'm going to try to summarize it. (Excel 2013)
I have created a Form+VBA project that does the following when you open the File: I check to see if it is the only workbook and if it is not then I remind the user to use a shortcut that I created that opens the file on its own instance. If it is on its own instance, It launches a Form, it makes the form unmovable, it also cancels the X button. Pretty much an "always on top of this instance of excel" form.
Private WithEvents App As Application
Private Sub Workbook_Open()
Set Wb = ThisWorkbook
If Application.Workbooks.Count > 1 Then
MsgBox "Please use the shortcut to open this file"
Application.DisplayAlerts = False
Wb.Close False
Else
Set App = Application
UserForm1.Show
End If
End Sub
I added triggers/event that when you open a New Workbook or an Existing workbook on the same instance it closes them and it opens them on a separate instance. Again this is because the form is "always on top".
Private Sub App_NewWorkbook(ByVal Wb As Workbook)
Set cwb = ThisWorkbook
If Wb.Name <> cwb.Name Then
Dim exDir As String, opFile As Variant
Application.DisplayAlerts = False
Wb.Close False
exDir = "C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE"
opFile = Shell("""" & exDir & """ /X", vbNormalFocus)
Application.DisplayAlerts = True
End If
End Sub
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
Set cwb = ThisWorkbook
If Wb.Name <> cwb.Name Then
Dim fDir, exDir As String, opFile As Variant
fDir = Wb.Path & "\" & Wb.Name
Application.DisplayAlerts = False
Wb.Close False
exDir = "C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE"
opFile = Shell("""" & exDir & """ /X """ & fDir & """", vbNormalFocus)
Application.DisplayAlerts = True
End If
End Sub
It works fine, up to a point.
Here is the issue: When the UserForm is closed, both triggers/events work fine for when you open a New Workbook or an Existing File, when the UserForm is active only the trigger for the New Workbook works. If I try to open another excel file it tries to open the file on the existing instance.
Well after fighting with it for more time I figured out the problem. When the form is active and you want to open an existing file, excel doesn't let the new file Open at all, therefore it never triggers the WorkbookOpen event, because the form is open. The NewWorkbook event works fine because is triggered when excel tries to open a NewWorkbook.
The way I got this to be fixed is by Allowing interaction between the Form and Excel using the vbModeless property on the UserForm1.Show command. This allows the excel window to be used while having the UserForm opened. Since I am making the form unmovable, non closable and I also resize excel to the same size as the form, this works for me. Now all evens trigger because the main Excel window can do everything, and therefore it triggers the WorkbookOpen events as well.
I have three files, one is app.xlsm, the other one is lib.xlsm, whereas app.xlsm uses lib.xlsm as a reference (which is specified in Tools -> References). The third, third.xlsm has the following code:
Private Sub Workbook_Open()
prompt = MsgBox("If you click Ok, Excel will force close." & vbCrLf & _
"If you click Cancel, you can work with the file", vbOKCancel)
If prompt = vbOK Then
Application.DisplayAlerts = False
thisworkbook.Close True
Application.Quit
End If
End Sub
Assume that I have app and lib open. Now when I open third, and then click OK at the prompt, app gets closed but lib remains open. I.e. Excel does not get force shut.
I need Excel to close all files without saving them and close silently.
Many thanks.
What happens if you loop through the open workbooks in this instance, ie
Private Sub Workbook_Open()
Dim wb As Workbook
prompt = MsgBox("If you click Ok, Excel will force close." & vbCrLf & _
"If you click Cancel, you can work with the file", vbOKCancel)
If prompt = vbOK Then
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then wb.Close False
Next
End If
ThisWorkbook.Saved = True
Application.Quit
End Sub
thermonuclear option to close all Excel instances
Private Sub Workbook_Open()
Dim wb As Workbook
prompt = MsgBox("If you click Ok, Excel will force close." & vbCrLf & _
"If you click Cancel, you can work with the file", vbOKCancel)
If prompt = vbOK Then
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then wb.Close False
Next
End If
X2 = Shell("powershell.exe kill -processname excel", 1)
End Sub
In the automation tool trainer has to mention student names and using that name the Excel file will be created. Example: Shreesha_xlsx.xlsx
After assigning the test with their names, IF the students open the Excel file of their own, THEN they should be able to see the userform (Welcome screen) and next screen is answering the questions.
The following code is that to assign the Excel file under the student name and after that I have also pasted the code that when user clicks on the Excel file it should open with userform.
Altogether it is calling userform of one Excel file in another without setting any reference.
Sub Button2_Click()
Dim s(6 To 100) As String
Dim stname As String
Dim status As String
Dim mypath As String
Dim u As String
u = "_xlsx"
For i = 6 To 100
s(i) = Range("E" & i).Value
stname = s(i) & "" & u
If s(i) = "" Then
ActiveWorkbook.Open = False
End If
'in case of Run time error
On Error GoTo jamun:
mypath = Range("B1").Value & "\" & stname
Workbooks.Add.SaveAs filename:=mypath
ActiveWorkbook.Close
Range("B" & i).Value = mypath & "_assigning..."
Application.Wait Now + TimeValue("00:00:02")
Range("F" & i).Value = "Done"
Range("B" & i).Value = mypath & "_assigned"
Range("B" & i).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="mypath", TextToDisplay:=Range("B" & i).Value
Range("B" & i).Select
Selection.Hyperlinks(1).Address = Range("B1").Value
Application.Wait Now + TimeValue("00:00:01")
Next
MsgBox "Test assigned successfully"
Exit Sub
jamun:
MsgBox "Test assigned successfully"
End Sub
Now the following code is that when they open, they should see the userform
enter code here
Sub Workbook_Open()
Dim FSO As New FileSystemObject
Dim objFolder As Folder
Dim objFile As File
Dim strpath As String
Dim a As Workbook
Dim filename As String
strpath = Range("B1").Value
Set objFolder = FSO.GetFolder(strpath)
If objFolder.Files.Count = 0 Then
MsgBox "No files were found....", vbExclamation
End If
For Each objFile In objFolder.Files
a = "Good" 'userform name is good
Workbook.Open (a)
VBA.UserForms.Add(a).Show
a.Show
Next objFile
End Sub
and don't know where I am going wrong.
1) Create an excel workbook with the desired form
2) Write code to open the form on Workbook_Open()
3) Write code in the form to fill the workbook with questions and whatever other information when the WB opens. All in all, make the behavior of the file exactly as you want it to behave when it opens to the student.
4) Save your file as a template (extension .xltm), let's say examTemplate.xltm
5) Now when you will generate exam files from the master file, generate them from the template. Consider changing this part of your code:
Workbooks.Add.SaveAs filename:=mypath
ActiveWorkbook.Close
Instead of this, we generate the file from the template:
Dim neWB as Workbook
Set newWB = Workbooks.Add("examTemplate.xltm") ' <~~~ generate from template
The freshly generated newWB inherits the template. That is, it has all its data, code, controls and forms. At this point, you can fill some data in newWB, things related to the assignment. That is, questions, or some parameters that will indicate where to fetch the questions, so that the form can access these parameters and do the work. Ideally, these parameters can be embedded in a hidden sheet. After then:
newWB.SaveAs filename:=mypath ' <~~ save it as macro-enabled .xlsm
newWB.Close
From that point, I think you can continue with with the same logic. The radical change in the approach is that the form will be readily embedded in the new workbook, not invoked from another workbook.
EDIT: you want your workbook to only show only the Form but never the workbook itself. This can be achieved by adding the following event handler to the ThisWorkbook code module of your template file:
Private Sub Workbook_Open()
If InStr(1, Me.Name, ".xltm") > 1 Then Exit Sub ' <~~ to apply only to chidren no to template itself
With Me.Application
.Visible = False
.DisplayAlerts = False
MyForm.Show
.Visible = True
End With
Me.Close
End Sub
I have added a button in excel sheet and added following codes in vba window of that button. Now when I click this button i.e. when I run the codes it saves the excel sheet in pdf form whose name it takes from cell no H8 and saves it at M:\formats. Moreover it also saves the same excel sheet in .xlsx format at M:\formats\excels. But here the problem is when I run the codes it closes the excel sheet in which I have added the codes and opens the file which is saved by the codes. For example I made abc.xlsm excel sheet and added the codes in vb window, now xyz is written in cell no h8 in abc.xlsm excel sheet, now when I will run the codes it closes abc.xlsm and all codes are shown in xyz.xlsx excel sheet. I want it should only save the file in xlsx format it requisite location. It should not close the base file (which is abc.xlsx in the above example) and should not open the saved file (which is xyz.xlsx in the above example). Moreover I want that the saved file (xyz.xlsx in the above example) should not contain any vba coding. In another words it should be just like the backup copy for the base file (which is abc.xlsx in the above example). Kindly help me in to modify these codes to them as I want. I will be highly obliged to you. Thanks
Sub ExportAPDF_and_SaveAsXLSX()
Dim wsThisWorkSheet As Worksheet
Dim objFileSystemObject As New Scripting.FileSystemObject
Dim strFileName As String
Dim strBasePath As String
strBasePath = "M:\formats\"
strFileName = Range("H8")
On Error GoTo errHandler
Set wsThisWorkSheet = ActiveSheet
wsThisWorkSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strBasePath & strFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created."
strBasePath = "M:\formats\excels\"
strFileName = Range("H8")
Application.DisplayAlerts = False
strFileName = objFileSystemObject.GetBaseName(strFileName) & ".xlsx"
wsThisWorkSheet.SaveAs Filename:=strBasePath & strFileName,
FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = False
MsgBox "Workbook now saved in XLSX format."
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Here is the code, with just two small changes. Both new sets of lines have the comment "New" in front of them.
Also just tidied up the error handling routine a little bit.
The way it works is this:
Store the filename of the current workbook in the variable 'strMasterWorkbookFilename'
The PDF file is created by 'exporting' the worksheet.
The Excel worksheet is then saved as an XLSX. This effectively 'closes' the original workbook.
3.1 The Button ("Button 8") is removed from the new XLSX worksheet and the workbook is saved again.
The code then re-opens the original workbook ('strMasterWorkbookFilename') and closes the current workbook.
Notes - Saving as the XLSX will remove the Macro code from the saved file. The Macro will remain in the main 'master' file.
Sub ExportAPDF_and_SaveAsXLSX()
Dim wsThisWorkSheet As Worksheet
Dim objFileSystemObject As New Scripting.FileSystemObject
Dim strFileName As String
Dim strBasePath As String
' NEW
Dim strMasterWorkbookFilename As String
strMasterWorkbookFilename = ThisWorkbook.FullName
strBasePath = "M:\formats\"
strFileName = Range("H8")
On Error GoTo errHandler
Set wsThisWorkSheet = ActiveSheet
wsThisWorkSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strBasePath & strFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created."
Application.DisplayAlerts = False
strFileName = objFileSystemObject.GetBaseName(strFileName) & ".xlsx"
wsThisWorkSheet.SaveAs Filename:=strBasePath & strFileName, FileFormat:=xlOpenXMLWorkbook
wsThisWorkSheet.Shapes("Button 8").Delete
ActiveWorkbook.Save
Application.DisplayAlerts = False
MsgBox "Workbook now saved in XLSX format."
' NEW
Workbooks.Open strMasterWorkbookFilename
Workbooks(strFileName).Close SaveChanges:=False
exitHandler:
Exit Sub
errHandler:
MsgBox "Error Saving file. The error is " & vbCrLf & Chr(34) & Err.Description & Chr(34)
Resume exitHandler
End Sub
Thanks for posting this as a new question. If I'd carried on modifying the original code in the first question, it would not have been useful for anyone else reading your original post.
I recorded vba code to do some conditional formatting. The result is stored in the workbook itself. Now I want to force the user not to save the workbook, instead after the code is run, it should automatically save the workbook using "Save As" into a non macro file using some unique identifier such as "yyyymmmdd, hhmm.xlsx" and it should also ask the user where to save.
Additionally, it should close the workbook without saving it and open the last saved as .xlsx file. I found some codes, but they are not exactly what I am looking for. Please help.
How about this
Option Explicit
Sub SaveAs()
Dim sDate As String
Dim FileName As String
'// format Date
sDate = Format(Now, "YYYYMMDD HHMM")
'// Save As Name
FileName = sDate
'// Save path
Application.Dialogs(xlDialogSaveAs).Show FileName
End Sub
add this code below your code
Per OP Comment
This should do it - Tested on Excel 2010
Option Explicit
Sub SaveAs()
Dim xlSaveAs As String
Dim xlPath As Variant
Application.ScreenUpdating = False
'// Save As Name
xlSaveAs = "Weekly Report - " & Format(Now, "YYYYMMDD HHMM") & ".xlsx"
'// Save path
Application.DisplayAlerts = False
xlPath = Application.GetSaveAsFilename( _
InitialFileName:=xlSaveAs, _
FileFilter:="Excel Files (*.xlsx), *.xlsx", _
Title:="My Save Dialog")
If xlPath <> False Then
ThisWorkbook.SaveAs xlPath, xlOpenXMLWorkbook
Else
MsgBox "Not Valid Path" '// Cancel
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Finally, You may find the Getting Started with VBA in Office 2010 article in MSDN helpful.
edit : I rewrite the code to do what you want
Public Sub SaveNewFile()
' Create a new file basing the name of the current file (without extension if it's an xlsm) and the creation time
Dim filename As String
filename = ThisWorkbook.Path & "\" & CreateObject("scripting.filesystemobject").getbasename(ThisWorkbook.Name) & Format(Now, "yyyyMMdd hhmm") & ".xlsx"
' Save the file under the new name in xlsx format
' This action close the file and reopen it with the new name
Application.DisplayAlerts = False
ThisWorkbook.SaveAs filename:=filename, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
End Sub