I have created a simple spreadsheet in Excel 2010 containing a form that loads as the spreadsheet opens. The employee fills out the required form data and presses a "Save" button macro utilizing the SaveAs method.
My question is if it possible to disable the form in the saved copy? The reason is that I would like to avoid the form to load when our bookkeeping department opens the copy to review the data.
To clarify this is how my vba code is
Sub SaveAsButton()
Dim applicationUserName As String
Dim saveLocation As String
Dim fileName As String
Dim weekNo As String
Dim year As String
weekNo = ThisWorkbook.Sheets("Service").Range("M4").Value
Debug.Print (weekNo)
year = ThisWorkbook.Sheets("Service").Range("R4").Value
Debug.Print (year)
applicationUserName = Application.UserName
Debug.Print (applicationUserName)
saveLocation = "w:\Service Users\" & applicationUserName & "\Service\"
Debug.Print (saveLocation)
fileName = "Service" & "-" & weekNo & "-" & year & "-" & applicationUserName
Debug.Print (fileName)
fileName = Replace(fileName, " ", "")
Debug.Print (fileName)
ThisWorkbook.SaveAs (saveLocation & fileName)
End Sub
Thank you.
If you don't need any code in the final workbook you could simply save as .xlsx and thereby remove all the vb components
You may want to use CustomProperties for that.
First, create a CustomProperty:
ActiveWorkbook.CustomDocumentProperties.Add "Saved", False, msoPropertyTypeNumber, 0
Change the value of the CustomProperty to 1 when user saves the form (add the following code to SaveAsButton()):
ActiveWorkbook.CustomDocumentProperties("Saved").Value = 1
Add a check if ActiveWorkbook.CustomDocumentProperties("Saved").Value = 0 to the method which opens the form.
Related
I'm trying to adapt an Excel form I created that uses drive locations to save copies of the form, to work with SharePoint in a similar manner. Currently, the first macro is set up such that it will search the contents of a particular folder to determine the next available number in the queue (i.e. if 1, 2 and 4 already exist, it will assign 3) and save the sheet as that next available number. When the sheet is complete, the second macro will save the file with a specified name based on data within the sheet, in another specified location (again based on data defined within the sheet). The drive is in the process of being retired in our company and everything moved to Cloud-based storage, so I would like a way to complete the same actions but using SharePoint directories.
The code for the first macro is as follows:
Dim strDir As String
Dim file As Variant
Dim savename As Integer
Dim savename_string As String
strDir = "R:\Queue\"
savename = 1
savename_string = CStr(savename)
file = Dir(strDir)
While (CInt(savename_string) = savename)
If file <> (savename & ".xlsm") Then
If file = "" Then
savename = savename + 1
Else
file = Dir
End If
ElseIf file = (savename & ".xlsm") Then
savename = savename + 1
savename_string = CStr(savename)
file = Dir(strDir)
End If
Wend
ActiveWorkbook.SaveAs ("R:\Queue\" & savename_string & ".xlsm")
And then the code for the second macro is as follows:
Dim answer As Integer
Dim error As Integer
Dim delete As String
answer = MsgBox("Are you sure you want to save sheet & close?", vbYesNo + vbQuestion, "WARNING")
If answer = vbYes Then
'Define PWO, assembly, terminal, strand, and gauge As Strings, and define which cells they are on the sheet
delete = ActiveWorkbook.Name
ActiveWorkbook.SaveAs ("R:\" & terminal & assembly & Space(1) & gauge & strand & Space(1) & PWO & Space(1) & Format(Now(), "MM-DD-YYYY") & ".xlsm")
Kill ("R:\Queue\" & delete)
ActiveWorkbook.Close
Else
Exit Sub
End If
Currently the second macro works correctly when replacing the locations with the SharePoint URL locations, but when doing the same with the first macro, it returns an error message "Bad file name or number" at the line file = Dir(strDir). Can I get this code in working order, or is there a better way I should go about this? Thanks!
New to VBA and have an assignment to create a sub that pastes from one workbook into a new workbook. A requirement for saving the file is that "the folder path be universal so other people can create this folder too". What amendment would I make to the ActiveWorkbook.SaveAs method to fulfill this? Thanks
Sub pasteTable()
Dim formatting As Variant 'create variable to hold formatting2 workbook path
formatting = Application.GetOpenFilename() 'user is prompted and selects path to formatting2 workbook and assigns to formatting variable
Workbooks.Open formatting 'formatting2 workbook is now active
Worksheets("Formatting").Range("B3:R13").Copy 'copies table from formatting2 workbook
Workbooks.Add 'add new workbook
Worksheets(1).Range("B3:R13").Select 'selects range on worksheet of new workbook to paste table
Selection.PasteSpecial xlPasteAll 'pastes table
Columns("B:R").ColumnWidth = 20 'ensures table has proper row and column heights/widths
Rows("3:13").RowHeight = 25
Worksheets(1).Name = "Table Data" 'renames worksheet
ActiveWorkbook.SaveAs "C:\Users\name\Desktop\names Excel Assessment VBA\names Excel Assessment VBA " & Format(Date, "dd/mmm/yyyy"), FileFormat:=xlOpenXMLWorkbookMacroEnabled
'saves workbook according to desired specifications
End Sub
Change your Save line to this:
ActiveWorkbook.SaveAs "C:\Users\" & Environ("Username") & "\Desktop\Excel Assessment VBA\Excel Assessment VBA " & Format(Date, "dd-mmm-yyyy") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
The Username system variable will adjust depending on the Windows account that is in use. Just make sure each user has those folders existing on their desktop too, or you will get an error. I also removed names from the folder names as i assume you were trying to do something with the username there as well. You can adjust that to your needs.
Your Date format needed to change too as it was including illegal characters.
You also forgot to include a file extension, so I added that as well.
There is a lot going on with that line, including a lot of mistakes, so you are going to have to play with it a bit until you get exactly what you need. You may want to simplify it a bit until you get the hang of all those things.
I think you have to add some more checks
The script expects the name of the tool-path-folder as constant ToolFolder.
Plus a second constant ToolBaseFolder that could be set to the parent-path `ToolFolder, e.g. a network path. If the const is empty, users desktop will be used.
If this path does not yet exist it will be created.
Option Explicit
Private Const ToolBaseFolder As String = "" 'if ToolBaseFolder is an empty string desktop will be used instead
Private Const ToolFolder As String = "MyNameForToolFolder"
Public Sub testWbToToolFolder()
'this is just for testing
Dim wb As Workbook: Set wb = ActiveWorkbook
saveWbToToolFolder wb, "test.xlsx"
End Sub
Public Sub saveWbToToolFolder(wb As Workbook, filename As String)
'you don't need this sub - but have the same code line in your main routine
wb.SaveAs getToolFolder & filename
End Sub
Public Function getToolFolder() As String
'this returns the toolfolder e.g. C:\Users\xyz\Desktop\MyNameForToolFolder
Dim basepath As String
basepath = ToolBaseFolder & "\"
If existsFolder(basepath) = False Then
If LenB(ToolBaseFolder) > 0 Then
MsgBox ToolBaseFolder & " does not exist." & vbCrLf & _
"File will be saved to " & ToolFolder & " on desktop ", vbExclamation
End If
basepath = getDesktopFolderOfUser
End If
Dim fullpath As String
fullpath = basepath & ToolFolder & "\"
If existsFolder(fullpath) = False Then
makeFolder fullpath
End If
getToolFolder = fullpath
End Function
Private Function existsFolder(path As String) As Boolean
If Len(path) < 2 Then Exit Function 'can't be a valid folder
existsFolder = LenB(Dir(path, vbDirectory)) > 0
End Function
Private Function getDesktopFolderOfUser() As String
getDesktopFolderOfUser = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
End Function
Private Function makeFolder(path As String)
'https://stackoverflow.com/a/26934834/16578424 plus comment from rayzinnz
CreateObject("WScript.Shell").Run "cmd /c mkdir """ & path & """", 0, True
End Function
I'm modifying a Gantt chart excel template I found online by Vertex42 for added functionality.
One of these modifications is a checkbox inside a sheet called "Config" that, when ticked, creates a backup of the Gantt chart whenever the document is opened.
For some reason, I cannot get this simple task to work.
I've tried using both the Form control and ActiveX control check boxes, with different error messages. As far as I can tell, the Form controls are unrecommended, so I'm using the code below in the ThisWorkbook excel object, based on what I've seen online.
Private Sub Workbook_open()
Dim backupFilename As String
Dim formattedDateTime As String
If Sheets("Config").OLEObjects("AutoBackupCheckbox").Object.Value = True Then
formattedDateTime = Format(Now, "d-MMMM-yyyy, h:mm:ss")
backupfilename = Replace(ActiveWorkbook.Name, ".xlsm", " - backup " & DateTime & ".xlsm")
ActiveWorkbook.SaveCopyAs (backupfilename)
End If
End Sub
This code is getting me the error message whenever I open the document or run the debugger,
Run-time error '1004':
Sorry, we couldn't find the <filename> - backup <day>-<month>-<year>, <hour>:<minute>:<seconds>.xlsm. Is it possible it was moved, renamed or deleted?
Any ideas?
UPDATE: After running the debugger, it's complaining on the ActiveWorkbook.SaveAs line.
UPDATE 2: Changed format of 'backupFilename' to remove the '.xlsm' in the middle.
UPDATE 3: Replaced Date with date/time without slashes, and replaced SaveAs with SaveCopyAs. Updated error message.
The argument for the SaveCopyAs call is missing the path of the file.
Replace code with
Private Sub Workbook_open()
Dim backupFilename As String
Dim formattedDate As String
Dim tempFilename As String
Dim workingPath As String
Dim i As Integer
i = 1
If Sheets("Config").OLEObjects("AutoBackupCheckbox").Object.Value = True Then
formattedDate = Format(Date, "d-MMMM-yyyy, ver " & i)
workingPath = Application.ActiveWorkbook.FullName
backupFilename = Replace(workingPath, ".xlsm", " - backup " & formattedDate & ".xlsm")
tempFilename = Dir(backupFilename)
While tempFilename <> "" ' if file already exists
i = i + 1
formattedDate = Format(Date, "d-MMMM-yyyy, ver " & i)
backupFilename = Replace(workingPath, ".xlsm", " - backup " & formattedDate & ".xlsm")
tempFilename = Dir(backupFilename)
Wend
ActiveWorkbook.SaveCopyAs (backupFilename)
End If
End Sub
I have this little VBA module that I call from one workbook to update all Excel Workbooks in a given folder. By update I mean it copies a module called GetActiveXControlValues and then runs this macro on each workbook in that folder. Now when I run this on my machine everything works fine. When my co-worker runs this same code with the same files, they gets a surprise after copying the module. When you go to look at the workbook that should have the new module called 'GetActiveXControlValues', instead there is no module by that name, instead it is called 'Module1'. In addition, when you look inside the new module it says 'Attachment has been removed' in red. I checked and my co-worker has the exact same Security Settings in Excel 2010 as I have.
I have enable all Macros and Trust VBA Project Object Model. I have Prompt me for enabling all ActiveX controls. I have Disable Trusted Documents unchecked and all the boxes on the Protected View tab. Anyone seen this before or have an idea what I can try to troubleshoot?
Sample Code:
Sub CopyModuleAndExecuteIt()
Dim wb As Workbook
Dim sFile As String
Dim sPath As String
Dim sFullMacroName As String
SetFolder
sPath = sExcelFolder
ChDir sPath
sFile = Dir("*.xls") ' File Naming Convention
Do While sFile <> "" ' Start of LOOP
' Open each Excel File in the specified folder
Set wb = Workbooks.Open(sPath & "\" & sFile) ' SET BP HERE!
Sleep (1000)
' Unprotect the Documents using SendKeys Hack
UnprotectVBADocument
' Import the GetActiveXControlValues Module into the Workbook
wb.VBProject.VBComponents.Import ("D:\GetActiveXControlValues.bas") ' SET BP HERE!
sFullMacroName = "'" & wb.Name & "'" & "!" & wb.VBProject.VBComponents.Item("GetActiveXControlValues").Name & ".GetActiveXControlValues"
' Run the GetActiveXControlValues Macro
Application.Run (sFullMacroName)
' Close the Workbook Saving Changes
wb.Close True
sFile = Dir
Loop ' End of LOOP
End Sub
If your co-worker has the exact same Security Settings in Excel 2010 as you have then the next thing that comes to my mind is the "Firewall". Check his firewall settings.
I was working to create an AddIn trough VBA code, i wrote the code in a Excel worksheet when i save it, i saved as text like this:
Attribute VB_Name = "Module_Name"
And you have to be sure that you .bas file is actualy is plain text.
I was working to create an AddIn with VBA code, i wrote the code in a Excel worksheet when i save it, i saved as text like this:
Sub Superheroes()
Dim sBeg as string, sEnd as String, sCatwoman as String, sAntMan as String
Dim vCode As Variant
'' Here is where i put the name i want to call my module
sBeg = "Attribute VB_Name = ""VBA_BasFile""" + vbCrLf + _
"Private Function fMix(sAnimal as String)as String "
sCatwoman = "Select case sAnimal"+ vbCrLf+ vbTab+"case ""cat"""+ _
vbCrLf+ vbTab+ "fMix = ""Catwoman"""
sAntMan = vbCrLf+ vbTab+"case ""Ant"""+ vbCrLf+ vbTab+ "fMix = ""AntMan"""+ _
vbCrLf+ "End Select"
sEnd = vbCrLf+ "End Sub"
vCode = Array(sBeg, sCatwoman, sAntMan, sEnd)
Workbooks.add
Range("A1").Resize(UBound(vCode) + 1, 1) = Application.Transpose(vCode)
With ActiveWorkbook
.SaveAs path + "VBA_BasFile.bas", xlTextPrinter
.Close False
End With
End Sub
With this i can Call any procedure or function in the VBA_BasFile when i importe to another Excel Workbook.
I need to export data in a sheet to a text file without changing the file name (i.e. not doing "save as". Also it would be great if the file name could look at the previous like file name in the folder and increase by 1 digit (i.e. :file_1.txt, file_2.txt, etc.)...
Thanks!!
If you want to avoid the current name of your excel file being changed, just save the current worksheet, not the whole workbook (the VBA equivalent of the SaveAs function is ActiveWorkbook.SaveAS, to save just the current sheet use ActiveSheet.SaveAS).
You can use the following macro:
Sub Macro1()
Application.DisplayAlerts = False
ActiveSheet.SaveAs Filename:="NewFile.txt", FileFormat:=xlTextWindows
Application.DisplayAlerts = True
End Sub
Toggling the DisplayAlerts property avoids a message box that is displayed if the given file already exists.
If want to save more than one sheet, you need to iterate through the Sheets collection of the ActiveWorkbook object and save each sheet to a separate file.
You can get a new file name as illustrated below, it includes a date. If you would like to add some details on what you want to export, you may get a fuller answer.
Function NewFileName(ExportPath)
Dim fs As Object '' or As FileSytemObject if a reference to
'' Windows Script Host is added, in which case
'' the late binding can be removed.
Dim a As Boolean
Dim i As Integer
Dim NewFileTemp As string
Set fs = CreateObject("Scripting.FileSystemObject")
NewFileTemp = "CSV" & Format(Date(),"yyyymmdd") & ".csv"
a = fs.FileExists(ExportPath & NewFileTemp)
i = 1
Do While a
NewFileTemp = "CSV" & Format(Date(),"yyyymmdd") & "_" & i & ".csv"
a = fs.FileExists(ExportPath & NewFileTemp)
i = i + 1
If i > 9 Then
'' Nine seems enough times per day to be
'' exporting a table
NewFileTemp = ""
MsgBox "Too many attempts"
Exit Do
End If
Loop
NewFileName = NewFileTemp
End Function