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
