Is there any way to use ActiveWorkbook.SaveAs without opening the destination file?
My main Workbook called TEC ALOC EXT has a code to when it's saved it's generate another file without macros in a different path (using FileFormat:=51) called ALOCACAO TECNICOS. But this type of FileFormat also opens the destination file (ALOCACAO TECNICOS) at the end and closes the TEC ALOC EXT worksheet.
This it not good for me because I want to keep changing things on my TEC ALOC SHEET sheet.
Is there any way to just save the ALOCACAO TECNICOSwithout opening it?
Here is my code:
Sub CopiarNovaPlanilha()
Application.EnableEvents = False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "I:\CGP\DEOPEX\01 - Supervisão\10 - Alocação das equipes\Consulta Alocados\ALOCACAO TECNICOS", FileFormat:=51
ActiveWorkbook.Sheets(1).Name = "FUNCIONARIOS"
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
That is triggered by AfterSave event:
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
If Success Then
Call CopiarNovaPlanilha
End If
End Sub
One way is this...
Sub CopiarNovaPlanilha()
Application.EnableEvents = False
Application.DisplayAlerts = False
ActiveWorkbook.Sheets.Copy
ActiveWorkbook.SaveAs "I:\CGP\DEOPEX\01 - Supervisão\10 - Alocação das equipes\Consulta Alocados\ALOCACAO TECNICOS", FileFormat:=51
ActiveWorkbook.Sheets(1).Name = "FUNCIONARIOS"
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Here's a website that should help you to accomplish what you need by using the FileSystemObject library. This will enable you to copy from one location to another without actually opening files as such.
The fist link will show you how to set up excel to use this.
http://www.wiseowl.co.uk/blog/s210/filesystemobject.htm
This link will describe in more detail about the FSO library and tell you a bit about the methods. Should give you enough to get started
http://www.wiseowl.co.uk/blog/s212/files-folders-vba.htm
Related
For learning and work purposes I needed to create mesage box that pop-ups first only first time opening workbook. For that task I found elegant solution in one of the old treads (old thread).
Working principle of sugested code is more or less clear to me exept part where named created with Application.Names.Add go? I checked under Forlulas -> name manager and did not find created name, I gues it went somwhere else?
Used Code:
Sub RunOnce()
Dim Flag As Boolean: Flag = False
For Each Item In Application.Names
If Item.Name = "FunctionHasRun" Then Flag = True
Next
If Flag = False Then
Call Application.Names.Add("FunctionHasRun", True, False)
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True
Call RunOnceFunction
End If
End Sub
Formulas -> Names only shows you the ThisWorkbook.Names and Worksheet.Names (depending on the scope of your Name).
If you insert a breakpoint and look at View > Locals Window you can find the Application.Names in Me > Application > Names.
My preferred method of adding an "opened" flag is to add to the CustomDocumentProperties. I've never seen anyone use Application.Names for this.
If what you want is for a messagebox to pop up when the workbook is opened then the following code will do that for you, simply place it under ThisWorkbook.
Also I'm pretty sure the syntax in your code is incorrect, if you wanted to add a Named Range you would do it as follows: Sheet1.Range("A1:Z10").Name = "MyNamedRange" there would be no need for the Call before it, as it isn't calling another subroutine/function:
Private Sub Workbook_Open()
MsgBox "This will pop up when the Workbook is opened!", vbInformation, "My MessageBox Title"
End Sub
UPDATE:
If you only want it to run the very first time the workbook is opened and then never again, the following will achieve that for you:
Sub RunOnce()
Dim Flag As Boolean: Flag = False
For Each Item In Application.Names
If Item.Name = "FunctionHasRun" Then Flag = True
Next
If Flag = False Then
Sheet1.Range("$A$1:$A$1").Name = "FunctionHasRun"
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.DisplayAlerts = True
Call RunOnceFunction
End If
End Sub
You cannot see it in the Name Manager because your third argument, Visible:=False, is set False.
Visible - True specifies that the name is defined as visible. False specifies that the name is defined as hidden. A hidden name does not appear in the Define Name, Paste Name, or Goto dialog box. The default value is True .
See Names.Add Method for more information.
I have a file that I made with three levels of permissions.
You get prompted to input a password on a userform and you get either admin rights, read/write or only read permissions.
That works fine, unless you don't enable macros.
If you don't enable the macro prompting the userform is not shown and the rights are not set thus you have full access.
I have seen you can use a splash screen but for that to work you need to save the workbook as far as I understand?
The basic concept of them is to beforeclose hide sheets and unhide splash screen, then save the workbook.
But what if the user made a mistake and what to close without save and reopen later? The file gets closed with all sheets visible?
So I thought maybe I can use the "explorer -> right click -> properties -> Read-only" attribute as an extra layer of protection?
I found these functions.
ActiveWorkbook.ChangeFileAccess Mode:=xlreadonly
ActiveWorkbook.ChangeFileAccess Mode:=xlreadwrite
But I tried the readonly line and it did set read only, file could not be saved.
Then I closed the workbook without saving and opened again. But it seems the attribute was not set in the properties of the file since it was not tickmarked and when I opened the file I could save it.
Is there any other way to solve this?
I want to either "force" VBA on the user or make sure he/she can't save the file if it's opened without VBA.
I found a solution that seems to work.
You can in Workbook_BeforeClose use this line to make the file read-only in file properties.
SetAttr Application.ActiveWorkbook.FullName, vbReadonly
This will set the tickmark in the properties and Excel will notice the file is writeprotected.
Then in Workbook_Open() (or as in my case when rights has been established)
SetAttr Application.ActiveWorkbook.FullName, vbReadwrite
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite
The first line removes the tickmark in file properties, but Excel still "remembers" the file as read-only.
The second line will tell Excel to make it ReadWrite and the file works as normal again.
This is a far more complicated method than Adreas', but doesn't feature the same risk of mildy tech-savvy users just right-clicking the file and popping into the "Properties" panel.
Create 2 new worksheets. One of them is set to xlVeryHidden - for the examples below, I have called it hsSheetStatus. The other, with a nice large notice telling your hapless minion colleague to enable Macros, will be changing visibility. I have called this hsEnableNotice.
Then I have a Macro to show hsEnableNotice hide all of the other sheets (storing their visibility and the ActiveSheet on hsSheetStatus), and a second Macro to do the reverse (restore visibility/ActiveSheet from hsSheetStatus) and set these to run on Workbook_BeforeSave, Workbook_AfterSave and Workbook_Open:
Option Explicit
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
UnlockAndShow
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
LockAndHide
End Sub
Private Sub Workbook_Open()
UnlockAndShow
End Sub
Private Sub LockAndHide()
Dim lSheet As Long, ActiveName As String
Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveName = ThisWorkbook.ActiveSheet.Name
hsEnableNotice.Visible = xlSheetVisible
hsEnableNotice.Activate
hsSheetStatus.Range(hsSheetStatus.Cells(1, 1), hsSheetStatus.Cells(hsSheetStatus.Rows.Count, 1)).EntireRow.Delete
For lSheet = 1 To ThisWorkbook.Sheets.Count 'By using Sheets instead of Worksheets, we include Charts etc
hsSheetStatus.Cells(lSheet, 1).Value = ThisWorkbook.Sheets(lSheet).Name
hsSheetStatus.Cells(lSheet, 2).Value = ThisWorkbook.Sheets(lSheet).Visible
If ThisWorkbook.Sheets(lSheet).Name = ActiveName Then hsSheetStatus.Cells(lSheet, 3).Value = 1
If ThisWorkbook.Sheets(lSheet).Name <> hsEnableNotice.Name Then ThisWorkbook.Sheets(lSheet).Visible = xlSheetVeryHidden
Next lSheet
ThisWorkbook.Protect Password:="ThisIsMyPassword.ThereAreManyLikeIt,ButThisOneIsMine.", Structure:=True, Windows:=False
Application.EnableEvents = True
End Sub
Private Sub UnlockAndShow()
Dim WasSaved As Boolean, lSheet As Long, lMax As Long
WasSaved = ThisWorkbook.Saved
Application.ScreenUpdating = False
Application.EnableEvents = False
lMax = hsSheetStatus.Cells(hsSheetStatus.Rows.Count, 1).End(xlUp).Row
ThisWorkbook.Unprotect Password:="ThisIsMyPassword.ThereAreManyLikeIt,ButThisOneIsMine."
For lSheet = 1 To lMax
ThisWorkbook.Sheets(hsSheetStatus.Cells(lSheet, 1).Value).Visible = hsSheetStatus.Cells(lSheet, 2).Value
If hsSheetStatus.Cells(lSheet, 3).Value = 1 Then ThisWorkbook.Sheets(hsSheetStatus.Cells(lSheet, 1).Value).Activate
Next lSheet
hsSheetStatus.Visible = xlSheetVeryHidden
hsEnableNotice.Visible = xlSheetVeryHidden
Application.EnableEvents = True
Application.ScreenUpdating = True
ThisWorkbook.Saved = WasSaved
End Sub
I made a workbook in which some sheets are needed to be protected from watching since a lot of people are going to enter this sheet and I would like to have more sensative information in it which will not be available for all.
To do so I googled and found out the following code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim MySheets As String, Response As String
MySheet = "Sheet1"
If ActiveSheet.Name = MySheet Then
ActiveSheet.Visible = False
Response = InputBox("Enter password to view sheet")
If Response = "MyPass" Then
Sheets(MySheet).Visible = True
Application.EnableEvents = False
Sheets(MySheet).Select
Application.EnableEvents = True
End If
End If
Sheets(MySheet).Visible = True
End Sub
which works perfectly for my needs but there is a problem.
The problem is as following, for it to work I need to force the user to enable macro commands and if you were to save the file then you'd have to save it as an macro-enabled workbook which is not something I trust my users to do.
My question is: Can I make so that without enabling the macro command you are unable to open the sheet without accepting the macros and you are unable to save as a normal Excel workbook?
I think the best answer here is password-protecting that worksheet using excel's built in functionality: http://www.excel-easy.com/examples/protect-sheet.html
EDIT: protecting sheet only prevents edits, suggested new method of hiding detailed here: http://www.techrepublic.com/blog/microsoft-office/hide-excel-sheets-really-hide-them/
I would like to know if there is a way to remotely deactivate an excel file via vba.
The problem:
My company uses an excel file for sales to provide quotations to the customer. Now when there is an update to our pricing scheme I send a new version of the Excel file to the sales team. The obvious thing that happens next is that they don't use the most current version of the file to give a quote => the customer gets a wrong price.
What I tried so far:
I implemented a time bomb that lets the file expire at a defined date. The problem with this is that updates to the excel file happen irregularly.
What I have in mind:
Once the excel file starts a VBA script queries a web server for the most current version number. If the version number in the currently opening Excel file is lower than the one provided by the server, the file locks up.
Is this something one can realize with Excel and VBA? I could imagine that this causes some problem with Windows Security etc. because it may look like a trojan or virus.
You help is much appreciated!
If you send them an .xlsm file the following code (courtesy of Tom Urtis from "VBA and Macros for Microsoft Excel"), will delete the file, when the chosen date has passed.
Please be careful with this code and always make sure to have a back-up copy saved.
Paste this sub in the "workbook" section of the vba and it is going to execute every single time the file is opened. If the current date is after the chosen date it will delete the file.
Private Sub workbook_open()
If Date > CDate("13.07.16") Then
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
End If
End Sub
You can also inspect but not by date, by file version, referring to the cell in which version will be available.
Private Sub workbook_open()
If [A1].value > "v.02.15" Then
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
End If
End Sub
Sub ПримерИспользования()
Dim ra As Range: On Error Resume Next
Set ra = GetQueryRange("http://ExcelVBA.ru/", 6)
Debug.Print ra '.Address ' переменная ra содержит ссылку на диапазон ячеек $A$1:$C$15,
' содержащий данные 6-й таблицы главной страницы сайта ExcelVBA.ru
End Sub
Function GetQueryRange(ByVal SearchLink$, Optional ByVal Tables$) As Range
On Error Resume Next: Err.Clear
Dim tmpSheet As Worksheet: Set tmpSheet = ThisWorkbook.Worksheets("tmpWQ")
If tmpSheet Is Nothing Then
Application.ScreenUpdating = False
Set tmpSheet = ThisWorkbook.Worksheets.Add
tmpSheet.Name = "tmpWQ"
tmpSheet.Visible = xlSheetVeryHidden
End If
If tmpSheet Is Nothing Then
msg$ = "Не удалось добавить скрытый лист «tmpWQ» в файл программы"
MsgBox msg, vbCritical, "Невозможно выполнить запрос к сайту": End
End If
tmpSheet.Cells.Delete: DoEvents: Err.Clear
With tmpSheet.QueryTables.Add("URL;" & SearchLink$, tmpSheet.Range("A1"))
If Len(Tables$) Then
.WebSelectionType = xlSpecifiedTables
.WebTables = Tables$
Else
.WebSelectionType = xlEntirePage
End If
.FillAdjacentFormulas = False: .PreserveFormatting = True
.RefreshOnFileOpen = False: DoEvents
.WebFormatting = xlWebFormattingAll
.Refresh BackgroundQuery:=False: DoEvents
If Err = 0 Then Set GetQueryRange = tmpSheet.UsedRange
.Delete: DoEvents
End With
End Function
Change the reference in line 3.
Turn window Locals Window the path ofView \ Locals Window.
Before starting the macro set Toggle Breakpoint (F9) in the line Debug.Print ra '.Address' ra variable contains a reference to a cell range $ A $ 1: $ C $ 15,
Run the macro, and in the window Locals Window selectra \ Value2 - it will be the data from the site.
Now the data from the site will be stored in the variable ra and take them can be similar to the following to change the line to:
Debug.Print ra.Value2(2, 2) 'result: "У вас есть интернет-магазин?"
This code is copied from the site: http://excelvba.ru/code/WebQueryRange
I'm having an issue in excel VBA with application.displayalerts = false.
When I send this command line in my program the displayalerts properties don't change to false, it remains true. When I execute it in the immediate window it turns to false. I couldn't find anything related to that.
I've already checked for the EnableEvent properties as I found on another topic, it is enabled.
I'm not sure which part of my code I should post because I tried this command both where I want it, in the middle of my code and as the first line of code. Also, this is running on an excel file which has other modules, some of them have public functions (which shouldnt affect anything) and some have public variables that I pasted below. Other than that, this is a complete independent code that don't really on the other ones
Public pctCompl As Integer
Public statCol As Collection
Public session As NotesSession
Public db As NotesDatabase
Public lmt As Integer
The code I'm using for the display alert
Application.DisplayAlerts = false
Let me know what else info you guys need or code
EDIT:
here's the code. Right after the line is executed the displayalerts propertie is still set to true, so it's not the case of it being set to true in other part of the code, the line is not changing the propertie, which is very strange because it does change it when I execute it on the immediate window
Sub Main()
Dim Mwksh As Worksheet
Dim Metwksh As Worksheet
Dim Swksh As Worksheet
Application.DisplayAlerts = False ''''''Dont work
'Set the worbooks
Set Mwksh = ThisWorkbook.Sheets(MASTER_SHT)
Set Swksh = ThisWorkbook.Sheets(SUPPORT_SHT)
'Open the Metrics workbook
Set Metwksh = OpenFile
'Find the Master File last column and row
clLast = LastCol(Mwksh, MASTER_HEADER_ROW)
rwLast = LastRow(Mwksh)
'Copy the content from the master file to the support sheet so it can be fixed before being copied to the metrics file
Swksh.UsedRange.ClearContents
Mwksh.Range(MASTER_FIRST_COL & MASTER_HEADER_ROW & ":" & clLast & rwLast).Offset(1, 0).Copy Destination:=Swksh.Range("A1")
DeleteColumns Swksh
InsertColumns Swksh
ClearDataSheet Metwksh
CopyToData Swksh, Metwksh
Metwksh.Parent.RefreshAll
Metwksh.Parent.Close savechanges:=True
MsgBox "Metrics file updated!"
End Sub
Use
Application.DisplayAlerts = False
Your code here
Application.DisplayAlerts = True
You forgot the s on end
If this does not solve the problem, use [your instance name].DisplayAlerts instead of Application.DisplayAlerts