Attach file and send email

[jedrei]

i have a bunch of files on a folder and i am looking for a code to attach 1 file and send email one at a time.

E. G. 30 files will send 30 emails with 1 attachment each and move the file to "SENT" folder

C:\ATTACHMENTS\ >>> files stored

C:\ATTACHMENTS\SENT\ >>> files will be moved here if it is already sent

 

[Diane Poremsky]

Description: Use the GetFolder function from the Microsoft Scripting Runtime FileSystemObject to get the Files list. Loop through that list and call for each file using Outlook's CreateItem function to create a new MailItem. Append the file to the MailItem´s Attachment.Add function. Then move the file.

I don't have code that moves the files, but i have this code that sends each file in an email -

Sub SendFilesinFolder()
   Dim sFName As String
 
   sFName = Dir("C:\Users\Diane\")
   Do While Len(sFName) > 0
     Call SendasAttachment(sFName)
     sFName = Dir
   Loop 
 
End Sub 
 
Function SendasAttachment(fName As String) 
 
Dim olApp As Outlook.Application 
 
Dim olMsg As Outlook.MailItem 
 
Dim olAtt As Outlook.Attachments 
 
Set olApp = Outlook.Application 
 
Set olMsg = olApp.CreateItem(0) ' email 
 
Set olAtt = olMsg.Attachments 
 
' attach file 
 
olAtt.Add ("C:\Users\Diane\" & fName) 
 
' send message 
 
With olMsg
 .Subject = "Here's that file you wanted"
 .To = "alias@domain.com"
 .HTMLBody = "Hi " & olMsg.To & "," & vbCrLf & "Attached is " & fName & " you requested."
 .Send 
 
End With 
 
End Function

 

[Diane Poremsky]

Here is a tweaked version of the macro - Use a macro to send files by email - it counts the files and prints a list in the Immediate window.

 

[suhasjose]

Thank yo uso much for this code! I had been using this for th epast 2 months which helped me to save a lot of time. Recently I came across a new scenario.. I need to attach all the files begining with same file name to a single email. For example; My folder contains 20 files. 5 of them have unique names (say 1 - 5) and they should go in five emails.Rest of the files have the same name and an extention (100,100#1,100#2, 200,200#1,200#2,200#3). Is there any way that I can attach all the files with which has same name before"#" into a single email?!

Thanks again for your help!

 

[Diane Poremsky]

It's doable. The do while / loop is moved to the function... it won't loop through looking for all the 100's, then all the 200's - you'll need to run it for each set of files. If you routinely use the same set of filenames, you could use an array to loop through them and do it in one step.

Sub SendFilesbyEmail() 
 
Call SendFiles("C:\Users\diane\Test\") 
 
End Sub 
 
Function SendFiles(fldName As String) 
 
Dim fName As String 
 
Dim strName As String 
 
Dim sAttName As String 
 
Dim olApp As Outlook.Application 
 
Dim olMsg As Outlook.MailItem 
 
Dim olAtt As Outlook.Attachments 
 
Set olApp = Outlook.Application 
 
Set olMsg = olApp.CreateItem(0) ' email 
 
Set olAtt = olMsg.Attachments 
 
fName = Dir(fldName) 
 
strName = InputBox("First 3 characters in filename?")
Do While Len(fName) > 0
 If Left(fName, 3) = strName Then
   olAtt.Add fldName & fName
   sAttName = fName & "<br /> " & sAttName
  End If
 Debug.Print fName
  fName = Dir 
 
Loop 
 
' send message 
 
With olMsg
 .Subject = "Here's that file you wanted"
 .To = "alias@domain.com"
 .HTMLBody = "Hi " & olMsg.To & ", <br /><br /> I have attached <br /> " & sAttName & "as you requested."
 .Display 
 
End With 
 
End Function

I added this code to Macro to send files by email

 

[Diane Poremsky]

As an FYI, here is an example of an array - http://www.slipstick.com/files/SendFilesArray.txt - it uses a 4-character filename prefix, you'll need to change this line to 3:

If Left(fName, 4) = strName Then

 

[suhasjose]

Thanks a lot for replying!

The only problem that I would face here is - I do not know the file names in the folders! That can be any name. Not a specific set of names since multiple people use to save files there.. How can I have a solution for this? Should I get a list of the file names first?!

Thanks&Regards

 

[Diane Poremsky]

With enough code, you could get the file names and sort by name and totally automate it. But it's more code than I have time for and I don't have any snippets handy that come close to doing that.

You'll could read the folder to get a list of file names then work with the list - you can use either vba or windows scripting host to bring it up.

 

[suhasjose]

Okay! I will try to chase it using your hints! This is going to be a good learning for me!

Thanks a lot for you help and guidance

 

[Diane Poremsky]

I'm pretty sure there are some snippets of VBA or windows script/ vbscipt laying around the interwebs that will get a list of the files.

 

[suhasjose]

I found some scripts in internet and combined everything together after making a few changes.. It works perfect now! The only problem that I face now is it skips file names if the name begins with a zero.

Thanks again Diane for your assistance..

---------------------------Dim strName As String

Sub SendFilesbyEmail()

Call ReadFiles("C:\Users\Test\")

End Sub

Function SendFilesArray(fldName As String)

Dim olApp As Outlook.Application

Dim olMsg As Outlook.MailItem

Dim olAtt As Outlook.Attachments

Dim fName As String

Dim sAttName As String

Dim arrName As Variant

Set olApp = Outlook.Application

'arrName = Array("2012", "2013", "2014")

' Go through the array and look for a match, then do something

'For i = LBound(arrName) To UBound(arrName)
'strName = arrName(i)

Set olMsg = olApp.CreateItem(0) ' email

Set olAtt = olMsg.Attachments

fName = Dir(fldName)


Do While Len(fName) > 0
If Left(fName, Len(strName) - 4) = Left(strName, Len(strName) - 4) Then
olAtt.Add fldName & fName
sAttName = fName & "<br /> " & sAttName
End If
'Debug.Print fName
fName = Dir

Loop

' send message

With olMsg
.Subject = "Here's that file you wanted" & fName
.To = "alias@domain.com"
.HTMLBody = "Hi " & olMsg.To & ", <br /><br /> I have attached <br /> " & sAttName & "as you requested."
.Display

End With

sAttName = ""

'Next i

End Function

Function ReadFiles(MyFile As String)

Dim Counter As Long

ReDim DirectoryListArray(1000)

MyFile = Dir$(MyFile)

Do While MyFile <> "" And InStr(1, MyFile, "#") = 0
DirectoryListArray(Counter) = MyFile
MyFile = Dir$
Counter = Counter + 1


Loop

ReDim Preserve DirectoryListArray(Counter - 1)

For Counter = 0 To UBound(DirectoryListArray)

strName = DirectoryListArray(Counter)
Debug.Print strName
Call SendFilesArray("C:\Users\Test\")

Next Counter

End Function