Saving files to Onedrive Folder in File Explorer - excel

I'm trying to save a file to an Onedrive folder that syncs within file explorer. Do I need a network path for this to work properly? This is what I have so far:
Sub Macro4()
Dim myDir, strFilename, strPathname, strDateTime As String
strDateTime = " (" & Format(Now, "hhmm AM/PM") & ")"
myDir = Environ("USERPROFILE") & "\Folder 1\Folder2\Folder3\" & Worksheets("Private").Range("L5").Value
strFilename = Worksheets("HWR DATA - Craft").Range("C1").Value
strPathname = myDir & "\" & strFilename
MyMkDir myDir & "\"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=strPathname & strDateTime & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
L5 refers to a cell that contains the following data:
Folder A\Folder B\Folder C

I found the issue. The problem was with my code running into a problem with Microsoft's max length for the path to my folder. (256-character limit for creating links to other files).

Related

Modify created macro to print array of sheets instead of Activesheet

I have a Macro that i have managed to put together (its rough, and im new to VBA but it does what i want - for the most part) It currently prints the active sheet to PDF and names it based on cell values. I want to adapt this to print 2 sheets into a single file (if its separate files, thats more than ok!) The cell Value naming bit can be changed at the top which i can do, but its calling for the export to pdf bit that im having an issue with.
I have tried reading up on the Activeworkbook functions but im not having much luck. I have tried calling for a sheet array, but it doesnt like the exportasfixedformat Type:= and im kind of new to that part too. It likes it in the original code, but not when i try and change the ActiveWorkbook.ActiveSheet, it spits it.
It would finalise my calculator :) Any help would be greatly appreciated.
Code:
Sub GetFilePath_Click()
Dim FileAndLocation As Variant
Dim strFilename As String
strFilename = Sheets("Leave Loading").Range("F13") & ", " & Sheets("Leave Loading").Range("F12") & " - " & Sheets("Leave Loading").Range("F14") & "- " & "Leave Loading" & ".pdf"
FileAndLocation = Application.GetSaveAsFilename _
(InitialFileName:=strPathLocation & strFilename, _
filefilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select a Location to Save")
ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFilename, OpenAfterPublish:=True
End Sub
Thank you in advance!
Option Explicit
Sub GetFilePath_Click()
Dim FileAndLocation As Variant
Dim strFilename As String, strPathLocation As String
strPathLocation = ""
With Sheets("Leave Loading")
strFilename = .Range("F13") & ", " & .Range("F12") & " - " _
& .Range("F14") & "- Leave Loading" & ".pdf"
End With
FileAndLocation = Application.GetSaveAsFilename _
(InitialFileName:=strPathLocation & strFilename, _
filefilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select a Location to Save")
Sheets(Array("Sheet2", "Sheet4")).Select
Sheets("Sheet2").Activate
ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFilename, OpenAfterPublish:=True
End Sub

Save file in successfully created folder: "file name or path doesn't exist"

This code creates a folder, but it does not save the file in it.
It shows an alert message
file name or path doesn't exist
startPath = "C:\Users\OsmonBek\Documents\macros"
myName1 = ActiveSheet.Range("A1").Text
Dim folderPathWithName As String
folderPathWithName = startPath & "\" & myName1
If Dir(folderPathWithName, vbDirectory) = vbNullString Then
MkDir folderPathWithName
Else
End If
' Save File
ActiveWorkbook.SaveAs Filename:= _
"folderPathWithName & \legend F22 A&P report " & Format(Now(), "DD-MMM-YYYY") & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
You have your quote characters wrong. Probably you mean folderPathWithName & "\legend F22 A&P report " so you get the content of the path variable into the filename.
Write the filename into an intermediate variable, that helps finding such errors:
' Save File
Dim newFileName As String
newFileName = folderPathWithName & "\legend F22 A&P report " & Format(Now(), "DD-MMM-YYYY") & ".xlsx"
ActiveWorkbook.SaveAs Filename:= newFileName _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Using the Current Month in a Folder Path in VBA Code

When I run this code I get an error message
"compile error: named argument not found".
Sub SavetoCurrentMonth()
Application.DisplayAlerts = False
' Check for month folder and create if needed
If Len(Dir("C:\Users\OsmonBek\Documents\macros test\" & Format(Month(Date), "P00-") & Format(Date, "mmmm"), vbDirectory)) = 0 Then
MkDir "C:\Users\OsmonBek\Documents\macros test\" & Format(Month(Date), "P00-") & Format(Date, "mmmm")
End If
' Save File
ActiveWorkbook.ExportAsFixedFormat Filename:= _
"C:\Users\OsmonBek\Documents\macros test\" & MonthName(Month(Date), False) & "\" & Format(Date, "mm.dd.yy") & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
' Popup Message
MsgBox "File Saved As:" & vbNewLine & "C:\Users\OsmonBek\Documents\macros test\" & MonthName(Month(Date), False) & "\" & Format(Date, "mm.dd.yy") & ".xlsx"
End Sub
The error was telling you that ExportAsFixedFormat doesn't have a parameter called FileFormat.
I'd use something like this function to return the name of the folder for the current month (creating the folder if it doesn't already exist) like c:\P2022_04\.
Function getMonthFolderPath() As String
'creates/returns folder name for current month, like: c:\P2022_04\
Const basePath = "c:\", prefix = "P"
Dim path As String
path = basePath & prefix & Format(Date, "yyyy_mm")
If Dir(path, vbDirectory) = "" Then MkDir path
getMonthFolderPath = path & "\"
End Function
I added the year since (I assume) you don't all April's in the same folder.
Here's a variation that will (if needed) create a year folder with a month subfolder, and return that path:
Function getMonthFolderPath() As String
Dim path As String
path = "c:\"
path = path & Year(Date)
If Dir(path, vbDirectory) = "" Then MkDir path
path = path & "\" & Format(Date, "mm")
If Dir(path, vbDirectory) = "" Then MkDir path
getMonthFolderPath = path & "\"
End Function
Either variation could be used to save the current file, like this:
Sub saveDemo()
'save this workbook like: C:\2022\04\2022-04-08.xlsm
Dim fName As String
fName = getMonthFolderPath & Format(Date, "yyyy-mm-dd") & ".xlsm"
Application.DisplayAlerts = False 'ignore overwrite warning
ThisWorkbook.SaveAs fName, xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
End Sub

How can I add the date to the excel file title with vba code?

Good morning,
Currently I this code below to create from sheet 5 some Excel files with same name at sheet. However I would like to add current date as: "List AA 30.03.2022".
Sub EXCELS()
'Create excel files
Dim i As Integer
Dim name_file As String
For i = 5 To Sheets.Count
name_file = Sheets(i).Name
Worksheets(i).Copy
With ActiveWorkbook
.SaveAs Filename:=ThisWorkbook.Path & "\" & name_file & ".xlsx",
FileFormat:=xlOpenXMLWorkbook
.Close SaveChanges:=False
End With
Next i
End Sub
What do I need to add?
Try this :
ThisWorkbook.Path & "\" & name_file & " " & Format(Date, "DD.MM.YYYY") & ".xlsx"
Replace the line .SaveAs Filename:=ThisWorkbook.Path & "\" & name_file & ".xlsx", FileFormat:=xlOpenXMLWorkbook with
.SaveAs Filename:=ThisWorkbook.Path & "\" & name_file & Format(Date, " dd.mm.yyyy") & ".xlsx", FileFormat:=xlOpenXMLWorkbook
EDIT
per your comment, in order to replace the file completely, you'll first need to save the old file name as a variable, then delete it afterwards.
So, replace the entire With block with the below;
With ActiveWorkbook
'variable to store the old file name:
Dim OldFileName as String
'assign the file's current name to the variable:
OldFileName = .FullName
'Now save the file with it's new name, then close it:
.SaveAs _
Filename:=ThisWorkbook.Path & "\" & name_file & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook
.Close
End With
'Get rid of the leftover file with the old name:
Kill OldFileName

Check for access to Sharepoint folder/If the folder exists

Simple macro to SaveAs a basic excel file to SharePoint and then do a bunch of other stuff. The macro works perfectly when the user has an access to the specified folder FLUX PL.
ActiveWorkbook.SaveAs Filename:="https://xxxxcorp.sharepoint.com/sites/CEEControlling/Shared%20Documents/Reporting/FLUX%20Analysis/FLUX%20PL/FLUX%20analysis%20PL%20" & Date & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
If the user doesn't have access (so he does not see the file), it half-saves in place of the original file so it is broken and I have to go to the previous version.
I tried include code to check if I have access/the folder exists in SharePoint, but it gives me
Run-time error '52': Bad file name or number.
mypath = "https://xxxxcorp.sharepoint.com/sites/CEEControlling/Shared%20Documents/Reporting/FLUX%20Analysis/FLUX%20PL"
mypath = Replace(Replace(mypath, "https:", ""), "/", "\")
mypath = Replace(mypath, Split(mypath, "\")(2), Split(mypath, "\")(2) & "#SSL")
If Dir(mypath, vbDirectory) = "" Then
MsgBox ("Doesnt exist!")
Else:
MsgBox ("Exists!")
End If
I also thought about On Error Goto [label] but by the time it gives me error the file is already renamed (and the original one broken).
I would be grateful for any help.
If anyone would need it in the future, I got it working. I try to save it and if it gives me error I use On Error GoTo and open SaveAs Dialog.
On Error GoTo savior
ActiveWorkbook.SaveAs Filename:= "https://xxxxcorp.sharepoint.com/sites/CEEControlling/Shared%20Documents/Reporting/FLUX%20Analysis/FLUX%20" & Range("H2").Value & "/FLUX%20analysis%20" & Range("H2").Value & "%20" & Date & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = False
On Error Goto 0
GoTo rest
savior:
MsgBox ("You do NOT have access to the default folder on Teams:" & vbNewLine & "Controlling CEE >> Reporting >> Files >> FLUX Analysis >> FLUX " & Range("H2").Value & vbNewLine & vbNewLine & "Select different location for the new trimmed file!")
Filename = "FLUX analysis " & Range("H2") & " " & Date
varResult = Application.GetSaveAsFilename(FileFilter:= _
"Excel Files (*.xlsx), *.xlsx", Title:="Select File Location", _
InitialFileName:=Filename)
If varResult <> False Then
ActiveWorkbook.SaveAs Filename:=varResult, _
FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = False
End If
On Error Goto 0
GoTo rest
rest:

Resources