I have this macro which works, but doesn't save to a specific folder...Sub saveandsnd()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(DateTime.Now, "dd-MM-yyyy") + ".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 = "emailhere" .CC = "emailhere" .Subject = xSht.Name + " " + "to be checked -" + " " + Format(DateTime.Now, "dd/MM/yyyy") .Attachments.Add xFolder .body = "Hi All," & vbNewLine & "Please find attached Tins that I need checking on CCF. I Hope it is self explanatory." & vbNewLine & "" & vbNewLine & "Hope you have a good shift." & vbNewLine & "" & vbNewLine & "Many Thanks," If DisplayEmail = False Then '.Send End If End With Else MsgBox "The active worksheet cannot be blank" Exit Sub End If End Sub
I've tried to use help to change/add things but doesn't seem to change the results
Do any of you know how to adapt this to save to a specific location?
thanks for your time....