Forum Discussion
Creating a vba code so the file save in month folders
You may try something like this...
Dim filename101 As String
Dim path101 As String
Dim fso As Object
Application.DisplayAlerts = False
Set fso = CreateObject("Scripting.FileSystemObject")
path101 = Environ("UserProfile") & "\Dropbox\A271\5 Oppgjør\" & Year(Date) & "\"
If Not fso.FolderExists(path101) Then
MsgBox "The folder " & path101 & " doesn't exist.", vbExclamation
Exit Sub
End If
filename101 = Range("B1").Value & ".xlsx"
ActiveWorkbook.SaveAs path101 & Range("A1").Value & "\" & filename101, xlOpenXMLWorkbook
Application.DisplayAlerts = True
Subodh_Tiwari_sktneer thanks for the code but its seems like the code dont want to run. its stops at Activeworkbook.saveas and dont run anymore.
1. I do have folder already created so the code for folder creating i dont think i need it. but it just stops working when the code comes to saving it dont do it.
2. Could please explain if that environ is something i have to copy to or remove it and why is the username in brackets? im new to this so im trying to learn.
3. Can you see if there is anything i can add on the code i wrote instead of writing all new? If its not possible to add anything then its no problem i can just go with that code.
Thanks
The Environ function is used to replace the bold part "C:\Users\Username\Dropbox\A271\5 Oppgjør\2020\" in the folder location.
What error msg do you get? The default error description would give you an idea about why the code gets failed. If the error msg has a file location in it, make sure the file location reported in the error msg exists.
Though the fso filesystemobject checks in the beginning if the path101 is a valid folder location and exists. So if the code execution passes that line it means the issue is with the month name entered in the A1.
Insert a breakpoint at the line which saves the active workbook and just before this line place the line given below, so that the code will stop at the breakpoint and debug.print will print the full path of the file being saved in the Immediate Window. See if it looks good in there, if not, tweak it accordingly.
Debug.Print path101 & Range("A1").Value & "\" & filename101Subodh_Tiwari_sktneer I found where the problem was and was able to fix it. Thanks for the help. i had one more question if you could here there too. the code i run now is the code i sent above. now the only problem is that how i learned from internet was to write it for every sheet and that will be to much code to write if i have 200 sheets to work on.
Do you know how to make the code i sent above to run through every sheet in that workbook? and also the same with this. both work togheter now but the problem is i have 200-300 sheets to work on every month so to write this same code so many times in vba with different path names makes it difficult.This is the whole code;
ActiveSheet.Next.Select
If Range("F3").Value = "" Then
Windows("Import OT.xlsm").Activate
Sheets("Cash").Select
Dim filename101 As String
Dim path101 As String
Application.DisplayAlerts = False
path101 = "C:\Users\Username\Dropbox\A271\5 Oppgjør\2020\"
filename101 = Range("B1").Value & ".xlsx"
ActiveWorkbook.SaveAs path101 & Range("A2") & "\" & Range("A1") & " " & filename101, xlOpenXMLWorkbook
Application.DisplayAlerts = True
Else
Cells.Select
Range("F3").Activate
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Dim Path1 As String
Dim Path2 As String
Dim oppgjør1 As String
Dim fpathname1 As String
Path1 = "C:\Users\Username\Dropbox\A271\4 Lønnslipper\"
Path2 = Range("F3")
oppgjør1 = Range("B3")
fpathname1 = Path1 & Path2 & "\" & Range("F2") & " " & oppgjør1 & ".xlsx"
ActiveWorkbook.SaveAs filename:=fpathname1, FileFormat:=51
ActiveWorkbook.CloseThe problem lays in that for it to run on every sheet i have to write this code 200 times with every path name different so it dont stop. If you could help me simplify it if possible or make a code which runs through every sheet in the workbook.
thanks