I have the following code which makes copies of the active workbook and gives each copy a different name. It works well, BUT I really need the original worksheet from which the code is run to stay active.
If I use the SaveCopyAs function instead, the copied files do not have the correct file format (.xlsm), and you cannot specify the file format as a parameter as in the saveAs function.
http://msdn.microsoft.com/en-us/library/bb178003%28v=office.12%29.aspx
http://msdn.microsoft.com/en-us/library/office/ff841185%28v=office.15%29.aspx
Sub makeCopies()
Dim name As Range, team As Range
Dim uName As String, fName As String, fFormat As String
Dim location as string, nName as string
location ="c:\test\"
nName = "Test - Team "
Set team = Names("Team").RefersToRange
For Each name In team
uName = nName & name.Value
fName = location & uName
fFormat = ThisWorkbook.FileFormat
ActiveWorkbook.SaveAs FileName:=fName, FileFormat:=fFormat
Next name
End sub
The best I can think of is to first make the copies with saveCopyAs and then access each file, save it in the correct file format with saveAs and then close it, but that means double work, and I would really hate to do that. Is there a smarter way?
This works form me. SaveCopyAs saves the workbook in the exact same format.
Sub makeCopies()
Dim name As Range, team As Range
Dim uName As String, fName As String, tempname As String
Dim location As String, nName As String
location = "C:\Test\"
nName = "Test - Team "
Set team = ThisWorkbook.Names("Team").RefersToRange
For Each name In team
uName = nName & name.Value
fName = location & uName & "." & _
Split(ThisWorkbook.FullName, ".") _
(UBound(Split(ThisWorkbook.FullName, ".")))
ThisWorkbook.SaveCopyAs fName
Next name
End Sub
Is this what you're trying? Tried and tested.
Related
I am saving workbooks with v[ ] next to them to differentiate between latest and earlier versions.
Workbook v1
Workbook v2
...
Workbook v365
Is there a way to create a dynamic formula that does the following:
Detects the current version (365)
References a specific cell (e.g. A2) in the previous version (Workbook v364)
Please let me know! Any help would be really appreciated.
Since you did not answer my clarification questions, the next code will assume that the current workbook is the active one, all versions exist in the same folder and the "reference cell" will be a range in the previous version workbook where from a value must be extracted and it will be found in a sheet named as the active one in the current workbook:
Sub referenceThePrevVersion()
Dim wb As Workbook, curVers As Long, curName As String
Dim prevVersName As String, refVal As Variant, arrCur
Const refCell As String = "A2"
Set wb = ActiveWorkbook 'it my be ThisWorkbook if you need this one where the code exists
curName = wb.name 'the current workbook name
arrCur = Split(curName) 'split its name by spaces and place the words in an array
curVers = CLng(Mid(Split(arrCur(UBound(arrCur)), ".")(0), 2)) 'extract the current version
prevVersName = VBA.replace(curName, "v" & curVers, "v" & curVers - 1) 'obtain the prev version decreasing a unit
'extract the value of refCell, without opening the previous workbook:
refVal = CellV(wb.Path & "\", prevVersName, wb.ActiveSheet.name, Range(refCell).address(, , xlR1C1))
MsgBox refVal 'show the extracted value...
End Sub
Private Function CellV(fpath As String, fName As String, SheetName As String, strRange As String) As Variant
Dim strForm As String
strForm = "'" & fpath & "[" & fName & "]" & SheetName & "'!" & strRange
CellV = Application.ExecuteExcel4Macro(strForm)
End Function
The extracted value is CellV. It now is shown in a message, you may use it as you need.
Of course, if you know the previous version name and its path, you can open it and do whatever you need with its data.
Please, send some feedback after testing the code. If something not clear enough, do not hesitate to ask for clarifications.
I'm trying to write a simple macro to run on my Mac (Excel 16.61, Mac Book Pro running Big Sur 11.4) that copies the visible rows of a table into a new workbook then saves the new workbook as a *.csv file.
The current (non-working) code:
Sub Macro()
Dim wb as Workbook
Dim wbOutput As Workbook
Dim FilePath As String
Set wb = ThisWorkbook
FilePath = "/path/to/filename.csv"
' Copy the visible rows of a filtered table
With wb.Sheets("WorksheetName").ListObjects("tblName")
.Range.AutoFilter Field:=18, Criteria1:="TRUE"
.Range.SpecialCells(xlCellTypeVisible).Copy
End With
' Paste the copied table rows into a new workbook and save as a *.csv file
Set wbOutput = Workbooks.Add
wbOutput.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
wbOutput.SaveAs FileName:=FilePath, FileFormat:=xlCSV, CreateBackup:=False
wbOutput.Close
End Sub
When I run it however I get the following error:
Run-time error '1004': Cannot access read-only document [filename]
Having spent a few hours searching on-line, I'm no closer to a solution. The internet's suggestions include:
Adding Excel in System Preferences.../Security & Privacy/Files and Folders (I can't see an obvious way of adding a new app, just remove the access rights of apps that already have folder access)
The GrantAccessToMultipleFiles function, but adding FilePath in the input array of the function makes no difference.
How can I create a *.csv file from the table?
Ran into the same issue but my file format was .txt but here was my solution after doing some research and getting some solid help from the Mac VBA Guru Ron De Bruin.
The code essentially bypass creating the output files, in my case .txt files in a folder location that has security protocols that cause the Error 1004 message and creates a subfolder in the Microsoft Folder under my User profile which for whatever reason Excel/Mac don't see as a security threat and allows the VBA to create/save the output file(s) into that folder.
Hopefully, you can extract out what you need from the code and Function to get yours to work. One other thing, since the output is going to such a weird folder location I suggest you save the folder path under your favorites on the Finder Left Panel so you can easily get to the files. See the MsgPopup box for the folder location
Sub Create_TxtFiles()
Dim MacroFolder As String
Dim nW As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim DT As String, RelativePath As String, wbNam1 As String, wbNam2 As String, Filepath As String
'Declarations
Set ws1 = ThisWorkbook.Sheets("Extract1")
Set ws2 = ThisWorkbook.Sheets("Extract2")
RelativePath = ThisWorkbook.Path & "/"
DT = Format(CStr(Now), "mm_dd_yyyy hh.mmam/pm")
wbNam1 = "Extract 1 Output" 'Creates the File Name
wbNam2 = "Extract 2 Output" 'Creates the File Name
MacroFolder = "Upload Files"
Call CreateFolderinMacOffice2016(MacroFolder)
'set the savepath as the obscure folder vba has access to'
savepath = Application.DefaultFilePath & MacroFolder & "/"
'copy the Output 1
ws1.Copy
ActiveWorkbook.SaveAs savepath & wbNam1 & DT & ".txt", FileFormat:=42
Workbooks(wbNam1 & DT & ".txt").Close
'copy the Output 2
ws2.Copy
ActiveWorkbook.SaveAs savepath & wbNam2 & DT & ".txt", FileFormat:=42
Workbooks(wbNam2 & DT & ".txt").Close
Application.ScreenUpdating = True
msgbox ("Upload file saved to folder: " & vbNewLine & vbNewLine & savepath)
End Sub
Function CreateFolderinMacOffice2016(NameFolder As String) As String
'Function to create folder if it not exists in the Microsoft Office Folder
'Ron de Bruin : 1-Feb-2019
Dim OfficeFolder As String
Dim PathToFolder As String
Dim TestStr As String
OfficeFolder = Application.DefaultFilePath
PathToFolder = OfficeFolder & NameFolder
On Error Resume Next
TestStr = Dir(PathToFolder & "*", vbDirectory)
On Error GoTo 0
If TestStr = vbNullString Then
MkDir PathToFolder
End If
CreateFolderinMacOffice2016 = PathToFolder
End Function
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 have looked at quite a lot of similar questions, but none of them seem to work for my specific issue.
I have a macro that saves my file with a new name if it encounters a file with the same name.
What keeps happening is that it saves the original file to the correct folder, but then when it encounters the file name the next time I save it, the instanced file gets saved to the same folder as the template rather than the folder that they should go to.
In the example below, my template file is saved in the "M:\Excel\" directory.
It saves the first "TEST" file into the "M:\Excel\SavedVersions\" directory since the file name doesn't exist yet.
Then when I run the macro again to have it automatically save an instanced version (ie - "TESTrev1"), it keeps saving the instanced versions to the "M:\Excel\" directory instead of saving it to the "SavedVersions" subfolder.
Not sure what needs to be changed or done differently to get the instanced versions to save to the correct folder.
Any help would be greatly appreciated!
Thanks in advance! :)
Sub TEST()
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:= _
GetNextAvailableName("M:\Excel\SavedVersions\TEST.xlsm")
End Sub
Function GetNextAvailableName(ByVal strPath As String) As String
With CreateObject("Scripting.FileSystemObject")
Dim strFolder As String, strBaseName As String, strExt As String, i As Long
strFolder = .GetParentFolderName("M:\Excel\SavedVersions\")
strBaseName = .GetBaseName("TEST")
strExt = .GetExtensionName(".xlsm")
Do While .FileExists(strPath)
i = i + 1
strPath = .BuildPath(strFolder, strBaseName & "rev" & i & "." & strExt)
Loop
End With
GetNextAvailableName = strPath
End Function
Your code was unnecessarily complex.
Try this simpler version.
Sub TEST()
ActiveWorkbook.Save
ActiveWorkbook.SaveAs fileName:= _
GetNextAvailableName("M:\Excel\SavedVersions\TEST.xlsm")
End Sub
Function GetNextAvailableName(ByVal strPath As String) As String
Dim i as Interger: i = 0
Do Until Len(Dir(strPath)) = 0
i = i + 1
strPath = "M:\Excel\SavedVersions\TESTrev" & i & ".xlsm"
Loop
GetNextAvailableName = strPath
End Function
Keep your code simple. If your path is constant then might as well define a variable for it so that it can be used whenever and whereever you want. This way if there is any change in the path, you have to make the change at only one place.
While saving the file, also specify the FileFormat parameter to avoid problems. You might want to read more about it HERE
Is this what you are trying?
Option Explicit
Const sPath As String = "M:\Excel\SavedVersions\"
Sub Sample()
Dim flName As String
flName = sPath & GetNextAvailableName()
ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:=flName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub
Function GetNextAvailableName() As String
Dim i As Integer: i = 1
Dim newFile As String
newFile = "TestRev" & i & ".xlsm"
Do Until Dir(sPath & newFile) = ""
i = i + 1
newFile = "TestRev" & i & ".xlsm"
Loop
GetNextAvailableName = newFile
End Function
I'm trying to get a macro that works perfectly in Excel 2011 for Mac to work in Excel 2016 for mac. The goal is to have the user specify a folder with .csv files in it, and then the macro loops through all the .csvs, opening each to copy information out of it into another Workbook.
The macro fails when trying to open the first .csv file in the user-chosen folder, with a 1004 error, file cannot be found.
(side note: Earlier in the macro, workbooks.open works perfectly with a user selected FILE)
The macro is huge, so I made a brand new smaller one just to get past this problem. Here is the smaller, test code, which has the same failing behavior:
Sub Test()
Dim folderpath As Variant
Dim filename As Variant
Dim newfilename As Variant
Dim wb As Workbook
Dim newfolderpath As Variant
folderpath = MacScript("choose folder as string")
newfolderpath = Replace(folderpath, ":", "\")
MsgBox (newfolderpath)
filename = MacScript("Choose file as string")
newfilename = Replace(filename, ":", "\")
MsgBox (filename)
MsgBox (newfilename)
MsgBox (Dir(filename))
MsgBox (newfolderpath & Dir(filename))
Set wb = Workbooks.Open(newfolderpath & Dir(filename))
End Sub
All the msgboxes provide expected values.
newfolderpath= the whole path with \ separators.
filename= the whole path and file name with : separators.
newfilename= the whole path and file name with \ separators.
Dir(filename)= just the file name.
newfolderpath & Dir(filename))= the entire path and file name with \
separators.
Set wb line gives:
Run-time error '1004'
'Hard DRIVE\USERS\DAVE\DESKTOP\CSVS\1.CSV'
could not be found.
Clearly the file is there, openable and works.
Any help is greatly appreciated.
Well, I think I found the answer, or at least an answer that works for my project.
I went back to the workbooks.open(user-selected FILE) from earlier in the macro, and discovered it was reading it as "/users/Dave/Desktop/csvs/1.csv". So, even though debug and msgbox were returning backslashes, it was somehow wanting forward slashes (You were partially right, Tim). Additionally, it clearly truncates the name of the Mac hard drive, and starts with the users directory. So, I just modified the variables to match this format, and voila, it worked. For those who are interested, here's the modified code I wound up using:
Sub Test()
Dim folderpath As Variant
Dim newfilename As Variant
Dim wb As Workbook
Dim newfolderpath As Variant
Dim newfp As Variant
folderpath = MacScript("choose folder as string")
newfolderpath = Replace(folderpath, ":", "/")
newfp = Right(newfolderpath, Len(newfolderpath) - InStr(newfolderpath, "/") + 1)
newfilename = Dir(newfp)
Set wb = Workbooks.Open(newfp & newfilename)
Exit Sub
Thanks to everyone that helped.