I am trying to validate the active workbook is the proper workbook from the proper folder in our shared drive. Otherwise, the user will save data and it will not be shared. A safety measure to ensure data entry.
Some users save a copy of the aforementioned 'active workbook' to their PC off of the shared drive, which leads to data loss.
I want to use a message box to alert the user they will not save data in the group file, then ask if they would like to open that file.
Upon hitting "Yes", the other file would open while leaving the existing document open.
The selection "No" or "Cancel" would end sub.
GOAL:
Use a message box to alert the user that they are not working on the shared document.
Upon selection, the yes button open the correct document.
CODE (in Workbook):
Private Sub Workbook_Open()
Dim Sheet1 As Worksheet
Set Sheet1 = Sheets("Invoices")
Dim folpath As String
Dim mypath As String
Application.ScreenUpdating = False
folpath = "K:\Purchasing_Utilities\1_UTILITIES\4_VENDOR_INVOICES\GHOST_CARD\Active_Pay_Tracker_22.xlsm"
mypath = Application.ActiveWorkbook.FullName
If mypath = folpath Then
GoTo Skip
Else
MsgBox "This file source is a locally saved file. To share changes, please open the Tracker in the K: drive." _
& " Would you like the system to open this file now?", VbMsgBoxStyle = vbOKCancel + vbCritical
'Here is where I am trying to get the message box to open the document
Skip
Sheet1.Range("P:P").Sort Key1:=Sheet1.Range("P:P"), Order1:=xlAscending, Header:=xlYes
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Activate
Application.ScreenUpdating = True
Just an example:
Result = MsgBox("This file source is a locally saved file. To share changes, please open the Tracker in the K: drive. Would you like the system to open this file now?", vbOKCancel + vbCritical)
If Result = vbOKCancel Then
MsgBox "You clicked OK"
Else: MsgBox "You clicked Critical"
End If
This looks as follows:
If you press "Ok", this is what you see:
So, if you want a vbYes, you'll need to add this to the original messagebox (which currently does not have a "Yes" button) and add the corresponding Result handling (if Result = vbYes then ... (open file)).
Related
When I execute the Set Obj =, Excel opens a PowerPoint file that exist in path (that works). When that file is big, there is a Cancel button available (from Windows/Excel, not from my VBA code). If you click that Cancel button, the next time I run this VBA code it always jumps to the eImport label, but only if the path is the same. It looks like the Cancel option remembers the command for the specific object and VBA/Excel remembers that it was once cancelled and do not allow to set it. Is there any way to reset it or make some workaround?
If Obj Is Nothing Then
'Handling fault when pptx import was cancel during loading
On Error GoTo eImport:
Set Obj = ActiveSheet.OLEObjects.Add(FileName:= _
PathName & SelectedDeviceType _
, Link:=False, DisplayAsIcon:=False)
Obj.Name = "ActivDev"
On Error GoTo 0
End If
Else:
MsgBox "Select device type", vbInformation, "Selection required"
End If
Exit Sub
eImport:
Set Obj = Nothing
MsgBox "Import was canceled", vbExclamation, "Import"
Exit Sub
I add On Error label jump which fixed debbuger issue but object to the same file can not be set till next Excel opening.
So I have an excel document that will just randomly break on me when opening it. I do have Code 1 in the VBA ThisWorkbook section but it doesn't start until I enable macros after opening it.
The images attached are in the order that they appear to me. One note is that I do have hidden files revealed and I only see the "Ownership file" when I have it open. I am on a shared network but I do not have the privileges to view where it all is open.
My current work around is to save the file under a different name and then delete the old file and rename it.
After researching a bit, someone stated it might have had to do with sorting. But I added Code 2 and I am still having the issue.
Code 1
Dim Result
Result = MsgBox("The Data in this document might be outdated. Would you like to refresh the Data Queries? This process could take a few minutes...", vbYesNo, "Data Query OutDated")
If Result = vbNo Then
Exit Sub
End If
MsgBox "Queries Will Refresh Upon Closing this window. Please wait"
ActiveWorkbook.Worksheets("SQLData").EnableCalculation = False
ActiveWorkbook.Worksheets("FlowBreakDown").EnableCalculation = False
Application.ScreenUpdating = False
Change_Background_Refresh False
ActiveWorkbook.RefreshAll
Application.ScreenUpdating = True
ActiveWorkbook.Worksheets("SQLData").EnableCalculation = True
ActiveWorkbook.Worksheets("SQLData").EnableCalculation = False
ActiveWorkbook.Worksheets("FlowBreakDown").EnableCalculation = False
MsgBox "Refresh Complete"
Call ResizeData
End Sub
Code 2
Dim Sht As Worksheet
' Clear all Sort Fields prior to Save & Exit
For Each Sht In Application.Worksheets
Sht.Sort.SortFields.Clear
Next Sht
End Sub
I am trying to achieve the following:
I have a workbook that whose job is to loop through a set of input files (from different departments), all of which are supposed to be identical. However, i have noticed that some departments tend to rename their sheets at will. I have code that loops through all files and checks whether a given sheet named "Template" is there or not.
Now, i have a long time to plan for this, but once the input from departments start pouring in, i have very little time to verify everything and import it. One such thing is to implement a "fix errors" function, which, among other things, checks for the presence of the "Template" sheet in the workbook. If it is not there, i want the macro to open the workbook, allow the user (me) to find the correct sheet, manually rename it to "Template", and then save and close. Only then do I want the code to continue to run (checking the next workbook or other errors in this same workbook), in a similar way that happens when a mesage box or file dialog opens.
I have the following for this function for now (part of a larger code, project is a custom class):
If Not project.FileHasSheet Then
answer = MsgBox("Open file and add sheet?", vbYesNo + vbQuestion)
If answer = vbYes Then
Set tempWorkbook = Workbooks.Open(ThisWorkbook.Path & "/Inputfiler/" & project.filename)
MsgBox ("done")
tempWorkbook.Close
Else
'do something
End If
The messagebox "done" is going to be removed once this works. The code above just opens the workbook and immediately closes it.
If Not project.FileHasSheet Then
answer = MsgBox("Open file and add sheet?", vbYesNo + vbQuestion)
If answer = vbYes Then
Set tempWorkbook = Workbooks.Open(ThisWorkbook.Path & "/Inputfiler/" & project.filename)
Do Until IsFileOpen(ThisWorkbook.Path & "/Inputfiler/" & project.filename) = False
DoEvents
Loop
MsgBox ("done")
tempWorkbook.Close
Else
'do something
End If
This does not work either. The other workbook opens and the "hourglass" starts spinning, not allowing the user to edit the newly opened workbook.
The IsFileOpen function is:
Function IsFileOpen(filename As String)
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
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
Case Else
Error errnum
End Select
End Function
Trying to create a macro that will open the Save As window with a file name defaulted in the prompt based on a cell value.
This code works in the initial file I used, however when I copy/paste it into different directories it doesn't show up.
Sub CommandButton1_Click()
Dim SvName As String
SvName = Sheets(1).Cells(6, 5).Value
MsgBox ("File should be saved as: " & SvName & ".xlsm")
Application.Dialogs(xlDialogSaveAs).Show SvName
End Sub
The odd thing is even when the code doesn't work (it opens a blank Save As dialogue without the file name inputted), the MsgBox still displays the correct value for SvName.
Why is it not working consistently?
Thanks.
I have inherited an excel project, which I’ve been tasked to automate and develop further.
Use case being
An order comes in
User opens the base (root) excel file
Types in the relevant info (customer, order, data, tasks, etc)
And saves the new task file in a folder with tasks in progress
Leaving the base (root) excel basic and ready for next order.
The new task file needs to have a certain file name structure, which has been sorted.
My problem comes in on ActiveWorkbook.SaveAs filename.
As I step through F5 the lines, it goes through all the steps, creates the filename, shows the Save As UI, correctly shows the right folder and suggested filename, and actually saves the file. As I come out of ErrHandler and the last Application.EnableEvents = yes - it crashes. It seems to either be closing the base file, opening the new, or transfer active workbook to the new save file.
Which is fine, if it could stop crashing.
If criticalInput then
Msgbox “U been bad, U Shall not PASS!”, vbCritical ‘Not actual text or box showing, just for demo.
Else
Dim fileSaveName As Variant
'### It Crashes after saving (possible at opening)
fileSaveName = Application.GetSaveAsFilename( _
InitialFileName:=tasksfolder & "\" & suggestFilename, _
fileFilter:="Excel-projectmappe med aktive makroer (*.xlsm), *.xlsm")
If fileSaveName <> False Then
'### here is where you would save your file
DoEvents ‘ Debugging research tells this should be here. Not that is changes anything.
ActiveWorkbook.SaveAs fileSaveName ‘ During dev this has been disabled.
End If ' SaveAs
End If ' criticalInput
ErrHandler:
'## Reset back to default
Application.DefaultFilePath = strDefault
Application.EnableEvents = True
End Sub
Debugging
I can save the file just nicely, if I disable SaveAs and work only on the base (root) excel file.
I can open the new task file and save it nicely. (Just being a bugger about overwriting, Y/N)
Debugging research said I needed a DoEvents prior to SaveAs
Debugging research also said only to have the most relevant references present (in my case unselect OLE Automation)
During debugging, I’ve also created, AfterSave() and Open(). They triggers normally during normal operation, but fails when SaveAs has crashed. Eg as I disable SaveAs or when I open the excel book normally.
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
On Error GoTo ErrHandler
If Success Then
Application.EnableEvents = False
'MsgBox "Success save", vbInformation ' for debugging purposes.
End If
ErrHandler:
Application.EnableEvents = True
End Sub
Private Sub Workbook_Open()
'MsgBox "I haz been opened, yehawww", vbInformation ' debugging
End Sub