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!
Related
So I have a currently working VBA script. I just want to edit the name by which the loop saves files.
I'll give a quick description of what it is currently doing. Basically it loops a set of actions for a defined range of rows, here A2:A72. The is a 'main' workbook where this loop is done is where all the input data is collected. Each row is a separate subject's input data and is copy/pasted into a template in a different workbook. Solver is then run to adjust the template for the given input data. Then it saves and names file as the text in the first cell of the row that was copy pasted. (ie A2,A3,A4,etc..) It then loops this for every row and every row will have its own template set up and saved separately.
This is ALMOST how I ideally want it to work.
I just want it save the File name not just as A2, but as =C2&" - "&A2
I tried using this that was suggested by someone
fName = Range("C" & c.Row) & Range("A" & c.Row)
But when I tried I would get a Method SaveAs error. On the watch view I could see it was because it wasn't reading the fName so it was just the file path in the script value. I changed it back to c.Value and then it started working by naming the file as the A column cell. Admittedly, I don't really understand how c.Value is returning column A which makes it harder for me to figure out how to modify it to get what I want.
Anyway here is the script as I currently have it:
Sub RunModels()
Dim fPath As String
Dim strTemplate As String
Dim fName As String
Dim wb As Workbook
Dim c As Range
Dim rngLoop As Range
'Where will files get stored?
fPath = "H:\ACQUISITIONS\Personal (D-AP)\Gmo\ALL MF"
'Where is the template file?
strTemplate = "H:\ACQUISITIONS\Personal (D-AP)\Gmo\ALL MF\Garden Grove - 11121 Chapman Ave.xlsm"
'Error check
If Right(fPath, 1) <Application.PathSeparator Then
fPath = fPath & Application.PathSeparator
End If
Application.ScreenUpdating = False
'Set Loop
Set rngLoop = ThisWorkbook.Worksheets("Sheet1").Range("A2:A72")
'Set Looped Actions
For Each c In rngLoop.Cells
'Open the template file
Set wb = Workbooks.Open(strTemplate)
'Add some data to the template file
c.EntireRow.Copy Destination:=wb.Worksheets("Insert
Sheet").Range("A2")
SolverOk SetCell:="$H$20", MaxMinVal:=3, ValueOf:=1.2, ByChange:="$F$35", Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve
'Dynamic File Naming
fName = c.Value
'Save the file and close
wb.SaveAs Filename:=wb.Path & Application.PathSeparator & fName
wb.Close
Next c
Application.ScreenUpdating = True
End Sub
Thank you very very much for all and any help!!
You should not use wb.Path wb is assigned to the workbook, where fPath is your folder path, so use:
Filename:=fPath & "\" & fName & ".xlsx"
or ".xlsm" as required.
To assign fName use:
fName = c.Offset(, 2).Value & " - " & c.Value
The code assigns the variable c to each cell in the range A2:A72 in turn - so at the moment it is saving the code 71 times. The code
fName = Range("C" & c.Row) & Range("A" & c.Row)
would produce c2 & A2 on the first time through, and then C3 & A3 on the second (and so on. I suspect you'd like it to always use c2 and then add the value in A - in which case you'd need
Fname = Range("C2") & "- " & c
Forgive me if this is an easy problem, Im still learning..
I have an excel file, that takes data and performs analytics to compose graphs. right now method to update is manual copying and pasting from 2 other data sources. I can easily create a macro to import the first source as the data location/file name is always the same. The second source is trickier, as the file has some standardized naming convention, but a date is added, as it is refreshed once a week, every Monday or tuesday. is there a way to automate pulling the data from the external source (sharepoint library) and telling it to find the most current version? either by understanding the date convention added in the file name, or by another means of modified date or other criteria? the file is kept with previous archived copies. I do not own the report, sharepoint site, or library it is kept in, so I cant influence those factors :(. any help appreciated, and I can provide better details and explanation.
There are two basic approaches that I know of, either allow the user to choose the file through a dialog box, or use the "Dir" function to find the file with the most recent date.
First approach (code I use frequently):
Public Function ChooseOpenFile() As String
Dim strSlash As String
If InStr(1, ActiveWorkbook.Path, "/") > 0 Then
strSlash = "/"
Else
strSlash = "\"
End If
With Application.FileDialog(msoFileDialogOpen)
.Title = "Select the first file to open in series:"
.InitialFileName = Replace(ActiveWorkbook.Path, "http:", "", 1) & strSlash
Call .Filters.Clear
Call .Filters.Add("Excel Files Only", "*.xls, *.xlsx, *.xlsb")
'only allow the user to select one file
.AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = .Show
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
ChooseOpenFile = .SelectedItems(1)
End If
End With
End Function
As for the second approach, as long as you can already access the folder programmatically, you build a loop to cycle through the files, extract the date from each file, test for being more recent than previous versions and store the filename of the most recent version to pass out of the loop.
Function MostRecentFile() As String
Dim dateTest As Date
Dim dateRecent As Date
Dim strMyFile As String
Dim strMyFolder As String
Dim strCurrentFile As String
Dim strSlash As String
strMyFolder = ThisWorkbook.Path
If InStr(1, strMyFolder, "/") > 0 Then
strSlash = "/"
Else
strSlash = "\"
End If
strMyFile = Dir(Replace(strMyFolder, "http:", "") & strSlash & "*.xls*")
Do While strMyFile <> ""
'Modify this line (number of characters and extension to replace) as needed.
dateTest = CDate(Replace(Right(strMyFile, 15), ".xls*", ""))
If dateTest > dateRecent Then
dateRecent = dateTest
strCurrentFile = strMyFile
End If
Stop
Dir
Loop
MostRecentFile = strCurrentFile
End Function
You can browse to the file.
Sub GetOpenFile()
Dim fileStr As String
fileStr = Application.GetOpenFilename()
If fileStr = "False" Then Exit Sub
Workbooks.Open fileStr
End Sub
If you want some kind of automated solution, based on your system date, like the next Monday ot Tuesday, you can get the machine to figure it out, and pass the result to the appropriate string in the file path.
Sub NameAsNextMon()
Dim K As Integer
Dim dteMon As Date
Dim tempName As Variant
K = Weekday(Now)
dteMon = Now() + (9 - K)
tempName = Year(dteMon) & "-" & Month(dteMon) & "-" & Day(dteMon) & ".xls"
Do
fName = Application.GetSaveAsFilename(tempName)
Loop Until fName <> False
ActiveWorkbook.SaveAs Filename:=fName
End Sub
I am getting a
Run-time error '1004' Method 'SaveAs' of object '_Workbook' failed.
The code works in excel 2010. I only get this error message in excel 2013.
The error message appears after trying to run the follow line.
ActiveWorkbook.SaveAs FolderPath & SaveName & NewSaveExt, 52
Background:
The spreadsheet is an .xls
When using the Saveas I am changing it to .xlsm
I have tried it with a .xls extension and fileformat 56 and it still falls over.
I am using code from the resources listed in the code.
I am saving the file to the same folder the workbook is in.
The orignal file name is: Financial Report as at month N.xls
The new filename is : Financial Report 1516 as at month 8.xlsm
Sub SaveNewVersion_Excel()
'PURPOSE: Save file, if already exists add a new version indicator to filename
'SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim NewSaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long
TestStr = ""
Saved = False
x = 0
NewSaveExt = ".xlsm"
'Version Indicator (change to liking)
VersionExt = "_v"
'Pull info about file
On Error GoTo NotSavedYet
myPath = ActiveWorkbook.FullName
myFileName = "Financial Report " & FileFinancialYear & " as at month " & MonthNumber
FolderPath = Left(myPath, InStrRev(myPath, "\"))
SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
On Error GoTo 0
'Determine Base File Name
If InStr(1, myFileName, VersionExt) > 1 Then
myArray = Split(myFileName, VersionExt)
SaveName = myArray(0)
Else
SaveName = myFileName
End If
'Test to see if file name already exists
If FileExist(FolderPath & SaveName & SaveExt) = False Then
ActiveWorkbook.SaveAs FolderPath & SaveName & NewSaveExt, 52
Exit Sub
End If
'Need a new version made
Do While Saved = False
If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
ActiveWorkbook.SaveAs FolderPath & SaveName & VersionExt & x & NewSaveExt, 52
Saved = True
Else
x = x + 1
End If
Loop
'New version saved
MsgBox "New file version saved (version " & x & ")"
Exit Sub
'Error Handler
NotSavedYet:
MsgBox "This file has not been initially saved. " & _
"Cannot save a new version!", vbCritical, "Not Saved To Computer"
End Sub
Function FileExist(FilePath As String) As Boolean
'PURPOSE: Test to see if a file exists or not
'RESOURCE: http://www.rondebruin.nl/win/s9/win003.htm
Dim TestStr As String
'Test File Path (ie "S:\Reports\Financial Report as at...")
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
'Determine if File exists
If TestStr = "" Then
FileExist = False
Else
FileExist = True
End If
End Function
Error reproduction: I was able to reproduce the error when trying to save a workbook with a FileName that already exist.
This could happen because the code checks the existence of a file named with extension SaveExt (using Function FileExist) but then try to save it as a file named with extension NewSaveExt. If these extensions are not the same then it’s possible that the file named with extension NewSaveExt already exist raising the
Run-time error ‘1004’: Method ‘SaveAs’ of object ‘_Workbook’ failed.
However this alert:
A file ‘Financial Report as month .xlsm’ already exist in this
location. Do you want to replace it?.
Should have been displayed before the error 1004
Unfortunately I cannot test the code posted in Excel 2010, but I personally think this behavior is not exclusive of Excel 2013.
Solution: If the objective is to always save the file as xlsm (value of NewSaveExt) then the code should validate the existence of a filename with that extension.
Additional comments about the code posted:
It’s a best practice to declare all variables. These variables are not declared:
TestStr, FileFinancialYear, MonthNumber, myFileName, myArray
These lines are redundant as no need to initialize variables that have not been used as yet, so they are already holding their initialized value.
TestStr = ""; Saved = False; x = 0
Suggest to use constant instead of variables for these (see Variables & Constants)
NewSaveExt = ".xlsm"; VersionExt = "_v"
New workbooks are not detected as the error handler NotSavedYet which is supposed to be triggered when the ActiveWorkbook has not been saved before (i.e. a new workbook) never gets fired as none of the commands between the On Error statements generate an error when dealing with new workbooks (see On Error Statement). If the intention is not to save New Workbooks, as implied by the error handler NotSavedYet, then validate the Path of the ActiveWorkbook, it will be empty if the workbook has not has been saved before.
The FileFinancialYear and MonthNumber variables never get populated.
Suggest to use specific workbook properties for Path and Name instead of FullName (see Workbook Object (Excel))
About the piece referred as Determine Base File Name
a. Programming: There is no need for IF statement, just use the Split function and take the item 0. The Split function returns ”a single-element array containing the entireexpression” when the delimiter is not present in the expression” (i.e. VersionExt and myFileName respectively).
b. Practicality: This piece seems to be redundant, as it’s meant to extract from variable myFileName the filename excluding the version and extension, however there is no such information in the variable as it has been populate just few lines above as:
myFileName = "Financial Report " & FileFinancialYear & " as at month " & MonthNumber
Therefore SaveName is always equal to myFileName
The first version of the file is indexed as 0 instead of 1.
The new indexed version will not always be the last index number + 1. If any of the previous versions is deleted or moved out to another folder as this version is missing the code will assign the missing version index to the latest file saved (see Fig. 1, note that time of the version 3 is newer than versions 4 & 5). Correction of this point requires a more complex approach as such it is not included in the revised code below.
Requirements: Based on the above a revised code is written that complies with the following requirements:
The procedure resides in a standalone workbook.
Files are always saved as xlOpenXMLWorkbookMacroEnabled (Extension xlsm)
New workbooks will not be saved as new versions.
Variables FileFinancialYear and MonthNumber are hardcoded as there is no indication of how they get populated (change as required).
The first time a file is saved and it does not exist in the source folder the file will be saved without version number.
The index of the first version should be 1 (change to 0 if required).
Option Explicit
Sub Wbk_SaveNewVersion_Xlsm()
Const kExt As String = ".xlsm"
Const kVrs As String = "_v"
Dim WbkAct As Workbook
Dim iYear As Integer, bMnth As Byte, sWbkStd As String
Dim sWbkPthNme As String, bVrs As Byte
Rem Set Standard Workbook Name
iYear = 2015 'Update Financial Year as required
bMnth = 9 'Update Month as required
sWbkStd = "Financial Report " & iYear & " as at month " & Format(bMnth, "00")
Rem Validate Active Workbook
Set WbkAct = ActiveWorkbook
If WbkAct.Name = ThisWorkbook.Name Then GoTo HdeThs
If WbkAct.Path = Empty Then GoTo NewWbk
Rem Get Workbook Properties
sWbkPthNme = WbkAct.Path & "\" & sWbkStd
Rem Validate Base File Existance
If Not (Fil_FileExist(sWbkPthNme & kExt)) Then
WbkAct.SaveAs sWbkPthNme & kExt, xlOpenXMLWorkbookMacroEnabled
MsgBox "A new workbook has been created: " & _
vbLf & vbLf & Chr(34) & sWbkStd & kExt & Chr(34), _
vbApplicationModal + vbInformation, "Workbook - Save a New Version - Xlsm"
Exit Sub
End If
Rem Save a New Version
bVrs = 1
sWbkPthNme = sWbkPthNme & kVrs
Do
If Fil_FileExist(sWbkPthNme & bVrs & kExt) Then
bVrs = 1 + bVrs
Else
WbkAct.SaveAs sWbkPthNme & bVrs & kExt, xlOpenXMLWorkbookMacroEnabled
Exit Do
End If
Loop
MsgBox "Version """ & bVrs & """ of workbook: " & _
vbLf & vbLf & Chr(34) & sWbkStd & Chr(34) & " has been created.", _
vbApplicationModal + vbInformation, "Workbook - Save a New Version - Xlsm"
HdeThs:
Call Wbk_Hide(ThisWorkbook)
Exit Sub
NewWbk:
MsgBox "Active Workbook """ & WbkAct.Name & """ has not been saved as yet." & vbLf & _
"A new version cannot be saved!", _
vbApplicationModal + vbCritical, "Workbook - Save New Version - Xlsm"
End Sub
Private Function Fil_FileExist(sFullName As String) As Boolean
Dim sDir As String
Fil_FileExist = (Dir(sFullName) <> Empty)
End Function
Private Sub Wbk_Hide(Wbk As Workbook)
Dim Wnd As Window
For Each Wnd In Wbk.Windows
Wnd.Visible = False
Next
End Sub
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.
I created a macro button to open my daily files from a excel production sheet where I have all the my macro button for specific files.
The format for all my files are conventionally the same:
Businese Unit Name: YMCA
Year:2012
Month: April
Week: Week 2
Day: 12
File Name: YMC Template 041212.xlsm
I am having issue with the last excel file name extension.
how do I add the MyDaily Template and MyDateProd along with the .xlsm.
I have this -J:.....\& myDailyTemplate & myDateProd.xlsm") see below for entire file path names.
Sub Open_DailyProd()
Dim myFolderYear As String
Dim myFolderMonth As String
Dim myFolderWeek As String
Dim myFolderDaily As String
Dim myDateProd As String
Dim myBusinessUnit As String
Dim myDailyTemplate As String
myBusinessUnit = Sheet1.Cells(32, 2)
myFolderYear = Sheet1.Cells(11, 2)
myFolderMonth = Sheet1.Cells(12, 2)
myFolderWeek = Sheet1.Cells(13, 2)
myFolderDaily = Sheet1.Cells(14, 2)
myDateProd = Sheet1.Cells(15, 2)
myDailyTemplate = Sheet1.Cells(6, 5)
Application.Workbooks.Open ("J:\IAS\3CMC05HA01\IAC Clients\myBusinessUnit\myFolderYear\myFolderMonth\myFolderWeek\myFolderDaily\& myDailyTemplate & myDateProd.xlsm")
End Sub
Excel is looking for a file called:
"J:\IAS\3CMC05HA01\IAC Clients\myBusinessUnit\myFolderYear\myFolderMonth\myFolderWeek\myFolderDaily\& myDailyTemplate & myDateProd.xlsm"
since that is what is included in the quotes, but from your code, you appear to have a number of variables that are part of this string, you need to take them out of the quotes and concatenate them together. Try something like this:
"J:\IAS\3CMC05HA01\IAC Clients\" & myBusinessUnit & "\" & myFolderYear _
& "\" & myFolderMonth & "\" & myFolderWeek & "\" & myFolderDaily & _
"\" & myDailyTemplate & myDateProd & ".xlsm"
I added the continuation _ to make it more readable onthe screen here, but it is not necessary, you can put everything on one line together if you prefer.
Unless you need all of the myBusinessUnit, myFolderYear, etc variables elsewhere, I would think about doing it in some sort of array and then doing a Join function to concatenate everything. I, personally, find this easier to maintain going forward and easier to see the hierarchy in the folder structure rather than looking at a very long string and trying to find what part of the path is wrong.
Sub Open_DailyProd()
Dim pathParts(1 To 10) As String
Dim path As String
pathParts(1) = "J:"
pathParts(2) = "IAS"
pathParts(3) = "3CMC05HA01"
pathParts(4) = "IAC Clients"
pathParts(5) = Sheet1.Cells(32, 2)
pathParts(6) = Sheet1.Cells(11, 2)
pathParts(7) = Sheet1.Cells(12, 2)
pathParts(8) = Sheet1.Cells(13, 2)
pathParts(9) = Sheet1.Cells(14, 2)
pathParts(10) = Sheet1.Cells(6, 5) & Sheet1.Cells(15, 2) & ".xlsm"
path = Join(pathParts, "\")
Application.Workbooks.Open (path)
End Sub