☰

VBA 스크립트 매크로를 특정 위치에 저장

tag-icon • tag-icon file-location
VBA 스크립트 매크로를 특정 위치에 저장

요청하는 대신 특정 폴더에 저장되도록 다음 스크립트를 어떻게 변경합니까?

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 = "[email protected]"
        .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

감사합니다, 마이클

답변1

선택한 항목이 라는 변수에 입력되는 것을 볼 수 있습니다.x폴더. xFolder가 추가되는 위치까지 xFileDlg에 대한 섹션을 주석 처리합니다.

원하는 대로 변경하세요.

xFolder = xFolder + "\" + xSht.Name + Format(Now, " yyyy-mm-dd hmmAM/PM") + ".pdf"

답변2

폴더를 선택해야 하는 유일한 이유는 바로 이 부분입니다..

xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) 설정

If xFileDlg.Show = True Then xFolder = xFileDlg.SelectedItems(1) Else MsgBox "PDF를 저장할 폴더를 지정해야 합니다." & vbCrLf & vbCrLf & "이 매크로를 종료하려면 확인을 누르십시오.", vbCritical, "대상 폴더를 지정해야 합니다." Exit Sub End If

매번 폴더를 선택하고 싶거나 새 폴더를 만들어야 하는 경우에 유용합니다. 그러나 폴더가 존재하고 항상 같은 위치에 저장하려는 경우 위 부분을 꺼내고 폴더 위치를 수동으로 추가하면 됩니다.

예:
xFolder = "C:\MyPDFs" + "\" + xSht.Name + Format(현재, " yyyy-mm-dd hmmAM/PM") + ".pdf"

관련 정보