Excel macro saving sheet as pdf to sharepoint to location dependent on input in new folder - excel

Question

I am new to VBA and have to complete a task for my manager about saving sheet as a pdf into sharepoint (if firstly can be done) which creates a folder at the location with the same name as the saved PDF and saves the pdf there.
Now where it gets harder for me is at the location in sharepoint there are 3 folders, for USD, EUR and GBP and depending on a field in the excel (which will denote one of the 3 currencies) it will have to be saved at that location
(Sharepoint URL or mapped to network drive)\Quote\USD\new folder created with file name matching pdf\pdf file
(Sharepoint URL or mapped to network drive)\Quote\EUR\new folder created with file name matching pdf\pdf file
(Sharepoint URL or mapped to network drive)\Quote\GBP\new folder created with file name matching pdf\pdf file
Is it the sharepoint URL will work or is it only when mapped to the network drive (which I have with a filepath with my username which im guessing would stop working from anyone else but me)
I am using the below which saves to sharepoint but with me as User_1 I cant see how anyone else will be able to?
Sub test()
ChDir "C:\Users\user_1\company\Sales Team - Documents\Quotes"
With Sheets("Quote")
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Users\user_1\company\Sales Team - Documents\Quotes\" & ActiveSheet.Range("B2").Value & " Quote.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
end sub
It took me a while to figure out the above (which im sure is really simple) but i am still learning,
Can anyone help me with this?
Thanks

Answer 1

OK, I probably overshot the targer a bit...
This code only works with drives mapped to the normal Filesystem, if you want to use a network path you can read some more on the topic here: Cannot save file to Sharepoint Online using VBA (Permissions error)
Unfortunately I do not have a way to test code against a Sharepoint Server until I get back to work.
First of, you need to add the Microsoft Scripting Runtime to your project, described here: https://stackoverflow.com/a/3236348
You can call the publishQuoteToDirectory sub from anywhere inside your project. I would recommend a custom Ribbon in the Application that passes the activeSheet Object, but you could also just point a Makro to runExportExample and fill in some static parameters.
sheetToPublish: Expects a Worksheet Object, you can use ActiveSheet if you want
publishingPath: The "Quotes" Folder
currencyCell: The Cell which holds the Currency
fileName: If you want to override the Filename for some reason
The Select Case structure decides which currency the Worksheet Contains, it also accepts the signs of the currencies, can be extended with whatever you want.
quoteNamePathPart I was not exactly sure how you meant this in your main question, this gives you the option to use the Workbook or the Worksheet Name, choose whichever you want.
The FileSystemObject helps us with building a valid path, there are other methodes to create this but I prefer using it over them because it gives direct access to the Microsoft Filesystem.
BuildFullPath is a separate sub because it has to call itself recursively. The FSO can not create nested Folder in one Action. An alternative would be to use the Shell (described here: https://stackoverflow.com/a/4407468).
This is the whole Magic, if you have any Question regarding the code feel free to ask.
There are definitely other easier, faster, more secure ways to solve this. My knowledge with VBA is still limited and I don't know all the best practices, but the code should get the job done. (#all the other, feel free to criticize)
Code:
'all this sits in a standart module:
Option Explicit
Private Const StandartCurrencyCell As String = "B2"
Private Const StandartFileName As String = "Quote.pdf"
Public Sub runExportExample()
publishQuoteToDirectory _
sheetToPublish:=ActiveSheet, _
publishingPath:="C:\Users\User1\company\Sales Team - Documents\Quotes\", _
currencyCell:="B2", _
fileName:="SomeOtherFileName.pdf"
End Sub
Public Sub publishQuoteToDirectory(sheetToPublish As Worksheet, Optional publishingPath As String, Optional currencyCell As String, Optional fileName As String)
'Sanitize the input if necessary
If publishingPath = "" Then publishingPath = Environ$("USERPROFILE") & "\Quotes\"
If currencyCell = "" Then currencyCell = StandartCurrencyCell
If fileName = "" Then fileName = StandartFileName
Dim currencyPathPart As String
Select Case sheetToPublish.Range(currencyCell).Value2
Case "USD", "$"
currencyPathPart = "USD"
Case "EUR", "€"
currencyPathPart = "EUR"
Case "GBP", "£"
currencyPathPart = "GBP"
Case Else
currencyPathPart = "OtherCurrencies"
End Select
Dim quoteNamePathPart
With New FileSystemObject
'I'm a bit sceptic on the correctness of this, since your PDF is called "Quote" the FOlder Name would be "Quote" as well
'Comment out whatever you don't want
'I think this should be:
quoteNamePathPart = .GetBaseName(sheetToPublish.Parent.Name) 'this will use the Workbook Name (without Suffix)
'not:
'quoteNamePathPart = sheetToPublish.Name 'This will use the Name of the Sheet
'build the path and create folder, using the FSO takes care of missing Seperators etc.
publishingPath = .BuildPath(publishingPath, currencyPathPart)
publishingPath = .BuildPath(publishingPath, quoteNamePathPart)
BuildFullPath (publishingPath)
publishingPath = .BuildPath(publishingPath, fileName)
End With
On Error GoTo ExportFailed
sheetToPublish.ExportAsFixedFormat _
Type:=xlTypePDF, _
fileName:=publishingPath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Exit Sub
ExportFailed:
MsgBox prompt:="The Export of the File: " & fileName & " failed" & vbCrLf & "The expected Output Path was: " & publishingPath, Title:="Export Failed"
End Sub
Sub BuildFullPath(ByVal FullPath)
'FSO can only create one Folder at a time, so I used a recursive function found here: https://stackoverflow.com/a/4407468
Dim fso As New FileSystemObject
If Not fso.FolderExists(FullPath) Then
BuildFullPath fso.GetParentFolderName(FullPath)
fso.CreateFolder FullPath
End If
End Sub