Saving Excel Files in a New Folder - excel

I've been running into issues for a while with trying to save Excel files in new folders. I think that it's connected to OneDrive folders trying to sync, but I can't find anything that helps confirm this issue. I've included a sample piece of code that replicates the issue I've had. If I run this once (creating a new folder), then I will get a SaveAs error. But if I immediately run it again, it will just ask to overwrite the file and it will save just fine. Is there a way to go about handling the save as error or to continue to try until it's saved successfully?
Sub save_file()
Dim folder_path As String
folder_path = "C:\Users\" & Environ("USERNAME") & "\OneDrive - Company Name\Desktop\Test Folder"
If Len(Dir(folder_path, vbDirectory)) = 0 Then
MkDir (folder_path)
End If
Dim new_book As Workbook
Set new_book = Workbooks.Add
new_book.SaveAs Filename:=folder_path & "\Test Book", FileFormat:=51
End Sub
EDIT: I was able to find a potential workaround, although I haven't done much yet to test it. This file is still being saved to the folder, so I can close the file that gives the save error, and then just reopen it (here also setting it as the same Workbook object for reuse.
Sub save_file()
Dim folder_path As String
folder_path = "C:\Users\" & Environ("USERNAME") & "\OneDrive - Company Name\Desktop\Test Folder " & Format(Now, "HHMMSS")
If Len(Dir(folder_path, vbDirectory)) = 0 Then
MkDir (folder_path)
End If
Dim new_book As Workbook
Set new_book = Workbooks.Add
book_name = folder_path & "\Test Book " & Format(Now, "HHMMSS")
On Error GoTo savehandler
new_book.SaveAs Filename:=book_name, FileFormat:=51
Exit Sub
savehandler:
new_book.Close
Set new_book = Workbooks.Open(book_name)
End Sub

Related

VBA to open Excel Workbook if file exists, and open a different if it does not

I have spent my whole morning on this and cannot get it working properly. A simple Excel userform was created asking for a filename. If the file exists in the directory I want it to open. If it does not exist I want a "template" file opened instead. I have the does not exist working properly, however cannot get the "does exist" part working. Please help.
Private Sub CmdEnter_Click()
Dim Path As String
Dim File As String
Path = Range("Search!B1")
File = TxtOrder.Value
'If File exists then open.
If Dir(Path & File & ".xlsm") = Path & File & ".xlsm" Then
Workbooks.Open FileName:=Path & File & ".xlsm"
'If File does not exist then open.
ElseIf Dir(Path & File & ".xlsm") = Error Then
Workbooks.Open FileName:=Path & "QCSFormTrial.xlsm"
End If
'Close Dialog and Close Workbook
Workbooks("QCSLaunch.XLSM").Close SaveChanges:=False
End Sub
Please, try this way:
Private Sub CmdEnter_Click()
Dim Path As String, File As String, wb As Workbook
Path = Range("Search!B1")
File = TxtOrder.value
'If File exists then open.
If dir(Path & File & ".xlsm") <> "" Then
Set wb = Workbooks.Open(Path & File & ".xlsm")
Else 'else, open the other one:
Set wb = Workbooks.Open(Path & "QCSFormTrial.xlsm")
End If
Stop 'check if the workbook has been open and press F5 to let code finishing
wb.Close SaveChanges:=False
End Sub
The issue is that Dir(Path & File & ".xlsm") = Path & File & ".xlsm" is basically saying does the folder path I named equal the folder path I named. The path isn't actually directed at the actual folder in way that will open it.
Try this: https://exceloffthegrid.com/vba-code-loop-files-folder-sub-folders/
Sub LoopAllFilesInAFolder()
'Loop through all files in a folder
Dim fileName As Variant
fileName = Dir("C:\Users\marks\Documents\")
While fileName <> ""
'Insert the actions to be performed on each file
'This example will print the file name to the immediate window
Debug.Print fileName
'Set the fileName to the next file
fileName = Dir
Wend
End Sub
Or, you can remove the If Then and directly open the file. If the file exists, it will open, if not, it will error. You can use error handling then continue.

SaveAs Nonstop Loop

To get to the point of completion for my macro, I start with a downloaded file from the internet which downloads as .xls. After downloading it, I then need to save the file as a .xlsx and change the name of the document to be "dockactivity".
This is a macro that multiple people on multiple devices would be using so I need to keep Environ$("username") parts. (Unless that written wrong of course..)
This is a macro I use everyday for my job so I wanted to try and have it delete the original downloaded as well.
The problem I am running into:
It seems to get stuck in an endless loop of saving the file, closing it, opening it, etc.
Here is what I have in now (everything that is before the more cosmetic changes are done to the file). Please note that I am quite a novice at this type of stuff and have pieced together this code from multiple sources online/this site.
Sub dockactivity()
'
' dockactivity Macro
'
' push button to run
'
Dim Filename, Pathname, SaveFileName As String
Dim wb As Workbook
Dim UserName As String
UserName = Environ("username")
Pathname = "C:\Users\" & Environ$("username") & "\Downloads\"
Filename = Dir(Pathname & "Dock_Activity_*.xls")
Application.DisplayAlerts = False
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
wb.CheckCompatibility = True
Application.DisplayAlerts = False
wb.SaveAs Filename:="dockactivity", FileFormat:=xlOpenXMLWorkbook
wb.Close SaveChanges:=False
Filename = Dir(Pathname & "Dock_Activity_*.xls")
Loop
Application.DisplayAlerts = True
If Dir(Pathname & "Dock_Activity_*.xls") <> "" Then
Kill (Pathname & "Dock_Activity_*.xls")
End If
Workbooks.Open (Pathname & "dockactivity.xlsx")
Windows("dockactivity.xlsx").Activate
Thanks for any help provided.

File Won't Save to Variable Folder

I am trying to create a record for training that employees complete. I have the forms set to create a folder with their employee number and then save the file with the training title. However, it is erroring out on my saveas line of code... not sure what is missing or wrong...
Sub submitgen()
Dim empnum As String
Dim traintype As String
empnum = Sheets("GENERAL TRAINING").Range("E7").Value
traintype = Sheets("GENERAL TRAINING").Range("E13").Value
If Len(Dir("C:\Emily\test\" & empnum, vbDirectory)) = 0 Then
MkDir "C:\Emily\test\" & empnum
End If
ActiveWorkbook.SaveAs "C:\Emily\test\" & empnum & "\" & traintype, FileFormat:=52
End Sub
What'd I mess up folks?

Create a folder in My Documents and save a workbook to that folder

I created an Excel Add-In that is used on a workbook with imported data. I need to add code that will do the following:
Check if folder exists C:\Users\\My Documents\ Extract
Files\
Create the folder if it does not exist
Save the file into this folder with current date and time (Now) in the file name with an .xlsx extension.
Example: C:\Users\jdoe\My Documents\Extract Files\Extract - 01-15-2016 15:15.xlsx
I have found this, but need to know how to get my criteria above into this code:
ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=xlOpenXMLWorkbook
I do not know enough about VBA to create a folder if it does not exist (if you can do this with VBA). I have looked but could not find anything that was helpful. Asking for some guidance here. Thanks.
Try this code:
Sub Ex()
If InStr(LCase$(ActiveWorkbook.name), "extract") > 0 Then
Exit Sub
Else
Dim MyDir As String, fn As String
MyDir = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\Extract Files" ' change this to valid path
If Len(Dir(MyDir, vbDirectory)) = 0 Then MkDir MyDir
fn = MyDir & "\Extract - " & Format(Now, "mm-dd-yyyy hh_mm")
ActiveWorkbook.SaveAs Filename:=fn, FileFormat:=xlOpenXMLWorkbook
End If
End Sub
we can not use : in the file name
Give this a try:
Sub dural()
Dim folder As String, myFileName As String
folder = "C:\TestFolder\Extract Files"
On Error Resume Next
MkDir folder
On Error GoTo 0
myFileName = folder & "\" & "Extract - " & Format(Now, "mm-dd-yyyy hh mm") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=xlOpenXMLWorkbook
End Sub
after changing the folder name.................if you get a warning, click on the yes button
The macro will create the folder if it does not exist.

VBA to search for folder or create it

good afternoon all,
i am using the following code on my spreadsheet to save the file in a specific folder with a specific format:
Const csPath As String = "C:\Stationery Orders\"
MyName = ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:=csPath & Sheets("Stationery").Cells(1, 1) & Format(CStr(Now), "ddmmyyyy_hhmm") & " " & MyName & ".xlsm", FileFormat:=52
my problem is that i can't find a way to create this folder C:\Stationery Orders\ if the folder doesn't exist and also paste a shortcut on the user's desktop. Is that even possible? any ideas?
kind regards
Put a check before doing SaveAs. Something like,
If Dir(csPath, vbDirectory) = "" Then MkDir csPath
Then do the SaveAs
Try this. It will check if folder exists and create it if it doesn't exist.
Sub MyCuteSub()
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists("C:\temp\temptemptemp") Then
FSO.CreateFolder ("C:\temp\temptemptemp")
End If
End Sub

Resources