send mail with all attachment in a folder

[KlausW]

Hello
I use this VBA code to send mail with an attachment and it works as it should.
Someone who can help so that it sends all the files in a folder.
The name of the folder is in cell x18.
Anyone who can help?
Any help will be appreciated.
Best Regards
Klaus W

Sub maj_Rektangelafrundedehjørner1_Klik()
'Skal bruges
Dim MyOutlook As Object
Set MyOutlook = CreateObject("Outlook.Application")

Dim MyMail As Object
Set MyMail = MyOutlook.CreateItem(olMailItem)

MyMail.To = Range("x2").Value ' & "; " & Range("y3").Value & "; " & Range("y4").Value & "; " & Range("y5").Value & "; " & Range("ay6").Value

MyMail.Subject = Range("x9").Value
MyMail.Body = Range("x10").Value & vbNewLine & vbNewLine & Range("x11").Value & vbNewLine & _
        Range("x12").Value & vbNewLine & Range("x13").Value & vbNewLine & Range("x14").Value & vbNewLine & _
        Range("x15").Value

Attached_File = Range("x18").Value
MyMail.Attachments.Add Attached_File

MyMail.Send

'MoveAFile

End Sub

 

[John_w]

Untested. Replace:

Attached_File = Range("x18").Value
MyMail.Attachments.Add Attached_File

with:

Dim folder As String, file As String
folder = Range("x18").Value
If Right(folder, 1) <> "\" Then folder = folder & "\"
file = Dir(folder & "*.*")
While file <> vbNullString
    MyMail.Attachments.Add folder & file
    file = Dir()
Wend

 

[Vogateer]

Using a FileSystemObject should be able to do this:

Sub maj_Rektangelafrundedehjørner1_Klik()
    
    'Skal bruges
    Dim MyOutlook As Object
    Set MyOutlook = CreateObject("Outlook.Application")
    
    ' File system variables
    Dim folderName As String
    Dim FSOLibrary As Object
    Dim FSOFolder As Object
    Dim FileToAttach As Object
    
    'Set the file name to a variable
    folderName = Range("X18").Value2
    
    'Set all the references to the FSO Library
    Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
    Set FSOFolder = FSOLibrary.GetFolder(folderName)
    
    Dim MyMail As Object
    Set MyMail = MyOutlook.CreateItem(olMailItem)
    
    MyMail.To = Range("x2").Value ' & "; " & Range("y3").Value & "; " & Range("y4").Value & "; " & Range("y5").Value & "; " & Range("ay6").Value
    
    MyMail.Subject = Range("x9").Value
    MyMail.Body = Range("x10").Value & vbNewLine & vbNewLine & Range("x11").Value & vbNewLine & _
            Range("x12").Value & vbNewLine & Range("x13").Value & vbNewLine & Range("x14").Value & vbNewLine & _
            Range("x15").Value
    
    'Use For Each loop to loop through each file in the folder
    For Each FileToAttach In FSOFolder.Files
        MyMail.Attachments.Add FileToAttach.Path
    Next FileToAttach
    
    MyMail.Send
    
    'MoveAFile

End Sub

 

[KlausW]

Using a FileSystemObject should be able to do this:

Sub maj_Rektangelafrundedehjørner1_Klik()
   
    'Skal bruges
    Dim MyOutlook As Object
    Set MyOutlook = CreateObject("Outlook.Application")
   
    ' File system variables
    Dim folderName As String
    Dim FSOLibrary As Object
    Dim FSOFolder As Object
    Dim FileToAttach As Object
   
    'Set the file name to a variable
    folderName = Range("X18").Value2
   
    'Set all the references to the FSO Library
    Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
    Set FSOFolder = FSOLibrary.GetFolder(folderName)
   
    Dim MyMail As Object
    Set MyMail = MyOutlook.CreateItem(olMailItem)
   
    MyMail.To = Range("x2").Value ' & "; " & Range("y3").Value & "; " & Range("y4").Value & "; " & Range("y5").Value & "; " & Range("ay6").Value
   
    MyMail.Subject = Range("x9").Value
    MyMail.Body = Range("x10").Value & vbNewLine & vbNewLine & Range("x11").Value & vbNewLine & _
            Range("x12").Value & vbNewLine & Range("x13").Value & vbNewLine & Range("x14").Value & vbNewLine & _
            Range("x15").Value
   
    'Use For Each loop to loop through each file in the folder
    For Each FileToAttach In FSOFolder.Files
        MyMail.Attachments.Add FileToAttach.Path
    Next FileToAttach
   
    MyMail.Send
   
    'MoveAFile

End Sub

It is just as it should be, thank you very much, Best Regards from Denmark KW