ОК, я, вероятно, немного перешагнул через targer ...
Этот код работает только с дисками, подключенными к нормальной файловой системе, если вы хотите использовать сетевой путь, вы можете прочитать больше на эту тему здесь: Невозможно сохранить файл в Sharepoint Online с помощью VBA (ошибка разрешений)
К сожалению, у меня нет возможности проверить код на сервере Sharepoint, пока я не вернусь к работе.
Сначалаиз, вам нужно добавить Microsoft Scripting Runtime к вашему проекту, описанному здесь: https://stackoverflow.com/a/3236348
Вы можете вызывать подпрограмму publishQuoteToDirectory из любой точки вашего проекта.Я бы порекомендовал пользовательскую ленту в приложении, которая передает объект activeSheet, но вы также можете просто указать Макро на runExportExample и указать некоторые статические параметры.
- sheetToPublish: Ожидается объект рабочего листа, вы можете использовать ActiveSheet, если хотите
- publishingPath: Папка "Quotes"
- currencyCell: Ячейка, которая содержитВалюта
- имя_файла: Если по какой-либо причине вы хотите переопределить имя файла
Структура Select Case определяет, какую валюту содержит рабочий лист, она также принимаетзнаки валют могут быть расширены с любым, что вы хотите.
quoteNamePathPart Я не совсем уверен, как вы имели в виду это в своем основном вопросе, это дает вам возможность использовать рабочую книгу или имя рабочего листавыберите тот, который вы хотите.
FileSystemObject помогает нам в создании правильного пути, есть другие методы для его создания, но я предпочитаю использовать его над ними, потому что этоВесь прямой доступ к файловой системе Microsoft.
BuildFullPath - это отдельная подпрограмма, потому что она должна вызывать себя рекурсивно.FSO не может создать вложенную папку в одном действии.Альтернативой может быть использование оболочки (описано здесь: https://stackoverflow.com/a/4407468).
Это вся магия, если у вас есть какие-либо вопросы относительно кода, не стесняйтесь спрашивать. Существуют и другие, более простые, быстрые, более безопасныеспособы решить эту проблему. Мои знания в VBA по-прежнему ограничены, и я не знаю всех лучших практик, но код должен выполнять свою работу. (@all другой, не стесняйтесь критиковать)
код:
'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