Макрос скрипта VBA сохранить в определенном месте

294
Michael Charry

Как изменить следующий скрипт, чтобы он сохранялся в определенной папке, а не спрашивал?

Sub Saveaspdfandsend() Dim xSht As Worksheet Dim xFileDlg As FileDialog Dim xFolder As String Dim xYesorNo As Integer Dim xOutlookObj As Object Dim xEmailObj As Object Dim xUsedRng As Range  Set xSht = ActiveSheet Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)  If xFileDlg.Show = True Then xFolder = xFileDlg.SelectedItems(1) Else MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder" Exit Sub End If xFolder = xFolder + "\" + xSht.Name + Format(Now, " yyyy-mm-dd hmmAM/PM") + ".pdf"  'Check if file already exist If Len(Dir(xFolder)) > 0 Then xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _ vbYesNo + vbQuestion, "File Exists") On Error Resume Next If xYesorNo = vbYes Then Kill xFolder Else MsgBox "if you don't overwrite the existing PDF, I can't continue." _ & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro" Exit Sub End If If Err.Number <> 0 Then MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _ & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File" Exit Sub End If End If  Set xUsedRng = xSht.UsedRange If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then 'Save as PDF file xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard  'Create Outlook email Set xOutlookObj = CreateObject("Outlook.Application") Set xEmailObj = xOutlookObj.CreateItem(0) With xEmailObj .Display .To = "" .CC = "csc.canada@philips.com" .Subject = xSht.Name + ".pdf" .Attachments.Add xFolder If DisplayEmail = False Then '.Send End If End With Else MsgBox "The active worksheet cannot be blank" Exit Sub End If End Sub

С благодарностью, Майкл

0
Добро пожаловать в Супер пользователя! Где вы взяли этот сценарий и что вы пробовали до сих пор? bertieb 6 лет назад 0

2 ответа на вопрос

0
HackSlash

Вы можете видеть, что выбранный элемент помещается в переменную с именем xFolder . Закомментируйте раздел о xFileDlg до места добавления xFolder.

Измените это на то, что вы хотите:

xFolder = xFolder + "\" + xSht.Name + Format(Now, " yyyy-mm-dd hmmAM/PM") + ".pdf"
Если это решило вашу проблему, отметьте решение. Зеленая галочка. HackSlash 6 лет назад 0
0
leach613

Единственная причина, по которой вам нужно выбрать папку, это эта часть ..

Set xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

Если xFileDlg.Show = True, то xFolder = xFileDlg.SelectedItems (1) Иначе MsgBox "Вы должны указать папку для сохранения PDF в." & vbCrLf & vbCrLf & "Нажмите OK, чтобы выйти из этого макроса.", vbCritical, "Необходимо указать папку назначения" Выйти из вспомогательного конца, если

Это замечательно, если вы хотите выбрать папку каждый раз или вам нужно создать новую папку. Но если папка существует, и вы всегда собираетесь сохранить ее в одном и том же месте, просто извлеките вышеуказанную часть и просто добавьте местоположение папки вручную.

Пример:
xFolder = "C: \ MyPDFs" + "\" + xSht.Name + Format (теперь, "гггг-мм-дд хммAM / PM") + ".pdf"

Похожие вопросы