erica3taylor
New Member
- Joined
- Jan 6, 2022
- Messages
- 6
- Office Version
- 2019
- Platform
- Windows
I have folders set up by manufacturer name and in those folders are there monthly invoices that are billed to them. I want a macro to be able email all invoices in each individual MFG folder to the respective MFG. Is there a way to set up a macro that can do this and possibly prompt me to input the email address to send it to or do this automatically instead of having to change each code to reflect a new email address.
So far I use this code, but I would have to change the email address each time i send to someone different and I want to avoid that and make this more automated.
Sub SendAllFilesInSeparateEmails()
Dim objShell As Object
Dim objWindowsFolder As Object
Dim objFile As Object
Dim strWindowsFolder As String
Dim objFileSystem As Object
Dim objMail As Outlook.MailItem
'Select a Windows folder
Set objShell = CreateObject("Shell.Application")
Set objWindowsFolder = objShell.BrowseForFolder(0, "Select a Windows Folder:", 0, "")
If Not objWindowsFolder Is Nothing Then
strWindowsFolder = objWindowsFolder.self.Path & "\"
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objWindowsFolder = objFileSystem.GetFolder(strWindowsFolder)
'Send each file in an email
For Each objFile In objWindowsFolder.Files
'Create a new mail
Set objMail = Outlook.Application.CreateItem(olMailItem)
'Change the details as per your needs
With objMail
.Subject = Left(objFile.Name, Len(objFile.Name) - (Len(objFileSystem.GetExtensionName(objFile.Name)) + 1))
.Attachments.Add objFile.Path
.Recipients.Add ("etaylor@ultradst.com")
.Recipients.ResolveAll
.Send
End With
Next
'Prompt you when completing sending
MsgBox "All done!", vbOKOnly + vbExclamation
End If
End Sub
any experts? Your assistance is greatly appreciated.
So far I use this code, but I would have to change the email address each time i send to someone different and I want to avoid that and make this more automated.
Sub SendAllFilesInSeparateEmails()
Dim objShell As Object
Dim objWindowsFolder As Object
Dim objFile As Object
Dim strWindowsFolder As String
Dim objFileSystem As Object
Dim objMail As Outlook.MailItem
'Select a Windows folder
Set objShell = CreateObject("Shell.Application")
Set objWindowsFolder = objShell.BrowseForFolder(0, "Select a Windows Folder:", 0, "")
If Not objWindowsFolder Is Nothing Then
strWindowsFolder = objWindowsFolder.self.Path & "\"
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objWindowsFolder = objFileSystem.GetFolder(strWindowsFolder)
'Send each file in an email
For Each objFile In objWindowsFolder.Files
'Create a new mail
Set objMail = Outlook.Application.CreateItem(olMailItem)
'Change the details as per your needs
With objMail
.Subject = Left(objFile.Name, Len(objFile.Name) - (Len(objFileSystem.GetExtensionName(objFile.Name)) + 1))
.Attachments.Add objFile.Path
.Recipients.Add ("etaylor@ultradst.com")
.Recipients.ResolveAll
.Send
End With
Next
'Prompt you when completing sending
MsgBox "All done!", vbOKOnly + vbExclamation
End If
End Sub
any experts? Your assistance is greatly appreciated.