Hi,
I us this code to mail clients with a maximum of 5 attachments.
The paths to the the attachments are in range R1:V1
I need to use a wildcard because the attached files can be any extension.
The paths I use now are:
G:\AHC\01. AHB Primair Proces\05. Teammappen\03. Team CCH PP\1b. AutoInvoerInsite\SlaHierBestandMailOp\3059380_1.???
....
....
....
G:\AHC\01. AHB Primair Proces\05. Teammappen\03. Team CCH PP\1b. AutoInvoerInsite\SlaHierBestandMailOp\3059380_5.???
But when I run the code I get this message:
"File -or Foldername is invalid"
Can someone help please?!
Thanks govi
I us this code to mail clients with a maximum of 5 attachments.
The paths to the the attachments are in range R1:V1
I need to use a wildcard because the attached files can be any extension.
The paths I use now are:
G:\AHC\01. AHB Primair Proces\05. Teammappen\03. Team CCH PP\1b. AutoInvoerInsite\SlaHierBestandMailOp\3059380_1.???
....
....
....
G:\AHC\01. AHB Primair Proces\05. Teammappen\03. Team CCH PP\1b. AutoInvoerInsite\SlaHierBestandMailOp\3059380_5.???
But when I run the code I get this message:
"File -or Foldername is invalid"
Can someone help please?!
Thanks govi
Code:
Sub Send_FilesGEA()
'Working in Excel 2000-2013
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("mail")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("F").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("R1:V1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = "info@mail.nl"
.Subject = "" & cell.Offset(0, 17).Value
.Body = "" & cell.Offset(0, 19).Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Display 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub