VBA toggle file path

[Jimbob2000]

I have a macro to take a worksheet, export it to PDF, save the file, then email it to a client (basically an invoicing spreadsheet).

Almost always, I want to save the exported PDF to the same default file, but very occasionally I might want to save it somewhere else. Currently, I always have to specify the destination folder to save the PDF in. What I want is have a cell on the active sheet where if the value is "yes" then it saves to a default folder (e.g., my documents) and if the value is "no" it opens the file dialogue to choose a save location.

It seems as though a simple If/Else should be able to do this, but I just can't figure out where to put it or how to express the default save location.

I'm including the full macro below -- any help would be greatly appreciated!

Sub Export_Invoice()



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.Range("L22").Text + ".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 = ActiveWorkbook.Sheets("Invoice Template").Range("L26")
        .CC = ActiveWorkbook.Sheets("Invoice Template").Range("L27")
        .Subject = ActiveWorkbook.Sheets("Invoice Template").Range("L28")
        .Body = ActiveWorkbook.Sheets("Invoice Template").Range("K31")
        .Attachments.Add xFolder
        If DisplayEmail = False And ActiveWorkbook.Sheets("Invoice Template").Range("N24") = "No" Then
            .Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub

 

[DanteAmor]

Try this
Change F1 and "C:\my documents" for your information.

Sub test1()
  Dim xEmailObj As Object
  Dim xUsedRng As Range, xSht As Worksheet, xFileDlg As Object, xFolder As String
  Dim xYesorNo As Variant, xOutlookObj As Object, DisplayEmail As Boolean
  
  Set xSht = ActiveSheet
  
[COLOR=#0000ff]  If xSht.Range("F1").Value = "yes" Then[/COLOR]
[COLOR=#0000ff]    xFolder = "C:\my documents"[/COLOR]
[COLOR=#0000ff]  Else[/COLOR]
    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
[COLOR=#0000ff]  End If[/COLOR]
  xFolder = xFolder + "\" + xSht.Range("L22").Text + ".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 = ActiveWorkbook.Sheets("Invoice Template").Range("L26")
          .CC = ActiveWorkbook.Sheets("Invoice Template").Range("L27")
          .Subject = ActiveWorkbook.Sheets("Invoice Template").Range("L28")
          .Body = ActiveWorkbook.Sheets("Invoice Template").Range("K31")
          .Attachments.Add xFolder
          If DisplayEmail = False And ActiveWorkbook.Sheets("Invoice Template").Range("N24") = "No" Then
              .Send
          End If
      End With
  Else
    MsgBox "The active worksheet cannot be blank"
    Exit Sub
  End If
End Sub

 

[Jimbob2000]

Worked perfectly! Thanks!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.