See https://www.slipstick.com/developer/...cros-schedule/ and use that process to run the following macro as required:
Option Explicit
Sub SendPDFs()
'Graham Mayor - https://www.gmayor.com - Last updated - 18 Nov 2021
Const sPath As String = "C:\Refunds\"
Const sMove As String = "C:\Complete\"
Const sTo As String = "someone@somewhere.com"
Const sMessage As String = "Please see the attached files:"
Dim sTempPath As String: sTempPath = Environ("Temp") & "\"
Dim xlApp As Object
Dim xlWB As Object
Dim strFile As String, sPDF As String
Dim sNewName As String, sOldName As String
Dim olItem As MailItem
Dim olInsp As Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim i As Long
Set olItem = CreateItem(olMailItem)
With olItem
.To = sTo
.Subject = "Attached worksheets"
.BodyFormat = olFormatHTML
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
.Display
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
xlApp.Visible = True
i = 0
strFile = Dir$(sPath & "*.xlsx")
Do While strFile <> ""
i = i + 1
If i = 1 Then Exit Do
strFile = Dir$()
Loop
If i = 0 Then
oRng.Text = "No files processed"
'.Send 'restore after testing
GoTo lbl_Exit
End If
oRng.Text = sMessage & vbCr
oRng.collapse 0
strFile = Dir$(sPath & "*.xlsx")
While strFile <> ""
sOldName = sPath & strFile
Set xlWB = xlApp.Workbooks.Open(sOldName)
sPDF = Replace(strFile, "xlsx", "pdf")
xlWB.Sheets(1).ExportAsFixedFormat Type:=0, _
FileName:=sTempPath & sPDF, _
Quality:=0, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
xlWB.Close SaveChanges:=False
.Attachments.Add sTempPath & sPDF
oRng.Text = sPDF & vbCr
oRng.collapse 0
Kill sTempPath & sPDF
sNewName = FileNameUnique(sMove, strFile, "xlsx")
Name sOldName As sMove & sNewName
strFile = Dir$()
Wend
'.Send 'restore after testing
End With
lbl_Exit:
Set xlApp = Nothing
Set xlWB = Nothing
Set olItem = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
End Sub
Private Function FileNameUnique(strPath As String, _
strFileName As String, _
strExtension As String) As String
'An Outlook macro by Graham Mayor
Dim lngF As Long
Dim lngName As Long
lngF = 1
lngName = Len(strFileName) - (Len(strExtension) + 1)
strFileName = Left(strFileName, lngName)
Do While FileExists(strPath & strFileName & Chr(46) & strExtension) = True
strFileName = Left(strFileName, lngName) & "(" & lngF & ")"
lngF = lngF + 1
Loop
FileNameUnique = strFileName & Chr(46) & strExtension
lbl_Exit:
Exit Function
End Function
Private Function FileExists(filespec) As Boolean
'An Outlook macro by Graham Mayor
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(filespec) Then
FileExists = True
Else
FileExists = False
End If
lbl_Exit:
Exit Function
End Function