LukeOR
05-17-2022, 01:22 PM
Hey guys,
Let me start by saying thank you for helping. You guys amaze me with how some of this code can be written, so simple, yet complex, it is most definitely an art form. I have a very limited, self taught knowledge of VBA, but I will try my best to explain my problem, or what I would like to accomplish.
I will try to explain this the best I know how,
I have a workbook where on the main page I create data to add to 1 of 8 sheets. The sheets are called 1, 2, 3,....8 Each sheet is basically a single page to print containing data. I want to save each of the 8 sheets as a new workbook into a folder on my computer using a value from each sheet ( lets say cell A1 ) as the file name. I would also like to load those 8 separate attachments into Outlook to send to some recipients. I would prefer to have this all set up in one macro I could run from a button. I have been able to get parts of this working, but I am having trouble tying everything together in one spot. For example: I have been able to Save the 8 sheets into a folder with the correct new filenames. And using some other code I have been able to load a single attachment into outlook (but the file name of attachment was not correct). If It helps, I will show the pieces of code I have that are working. Thanks to everyone for any help on this matter, much appreciated.
In summary, I would like to,
-Save each sheet (1-8) as a new workbook into a folder using value of A1 on each sheet as the filename
-Load those 8 new workbooks as an attachment in Outlook email to send
Here are some pieces of code I have that are working,
The following loads a single sheet in outlook with the filename "TempRangeForEmail",
I have been unable to get multiple files to attach, or get the filenames right.
Sub SEND_TO_OUTLOOK()
'SENDS SINGLE SHEET AS ATTACHMENT IN OUTLOOK
'VARIABLES
Dim OLApp As Outlook.Application
Dim OLMail As Object
'SAVES TO NEW WORKBOOK
Sheets("1").Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\TempRangeForEmail.xlsx"
'STARTS OUTLOOK
Set OLApp = New Outlook.Application
Set OLMail = OLApp.CreateItem(0)
OLApp.Session.Logon
With OLMail
.To = "WHOEVER.com"
.CC = ""
.BCC = ""
.Subject = "LOADS INTO SUBJECT LINE CORRECTLY"
.Body = "LOADS INTO BODY OF EMAIL CORRECTLY"""
.Attachments.Add (ThisWorkbook.Path & "\TempRangeForEmail.xlsx")
.Display
'CHANGE TO SEND ONCE WORKING
End With
ActiveWorkbook.Close SaveChanges:=True
Kill ThisWorkbook.Path & "\TempRangeForEmail.xlsx"
'Memory Cleanup
Set OLMail = Nothing
Set OLApp = Nothing
End Sub
And this code will save each sheet correctly with the correct filename into folder but I am unsure how to load these into Outlook as attachments, Also my apologies, I realize this code is unneccesarily long, which again points to my limited knowledge of VBA. But it was working.
To further confuse i know I mentioned cell A1 above, but this will be shown as S33 below.
Sub SAVES_TO_FOLDER() 'SAVES SHEETS TO FOLDER AS NEW WORKBOOKS
Application.ScreenUpdating = False
Dim fName As String
'SHEET 1
fName = Sheets("1").Range("S33").Value
Sheets("1").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 2
fName = Sheets("2").Range("S33").Value
Sheets("2").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 3
fName = Sheets("3").Range("S33").Value
Sheets("3").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 4
fName = Sheets("4").Range("S33").Value
Sheets("4").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 5
fName = Sheets("5").Range("S33").Value
Sheets("5").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 6
fName = Sheets("6").Range("S33").Value
Sheets("6").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 7
fName = Sheets("7").Range("S33").Value
Sheets("7").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 8
fName = Sheets("8").Range("S33").Value
Sheets("8").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
Application.CutCopyMode = False
End Sub
And versions I am using,
Microsoft® Outlook® for Microsoft 365 MSO (Version 2204 Build 16.0.15128.20158) 64-bit
Microsoft® Excel® for Microsoft 365 MSO (Version 2204 Build 16.0.15128.20158) 64-bit
Thank you all for your time
Let me start by saying thank you for helping. You guys amaze me with how some of this code can be written, so simple, yet complex, it is most definitely an art form. I have a very limited, self taught knowledge of VBA, but I will try my best to explain my problem, or what I would like to accomplish.
I will try to explain this the best I know how,
I have a workbook where on the main page I create data to add to 1 of 8 sheets. The sheets are called 1, 2, 3,....8 Each sheet is basically a single page to print containing data. I want to save each of the 8 sheets as a new workbook into a folder on my computer using a value from each sheet ( lets say cell A1 ) as the file name. I would also like to load those 8 separate attachments into Outlook to send to some recipients. I would prefer to have this all set up in one macro I could run from a button. I have been able to get parts of this working, but I am having trouble tying everything together in one spot. For example: I have been able to Save the 8 sheets into a folder with the correct new filenames. And using some other code I have been able to load a single attachment into outlook (but the file name of attachment was not correct). If It helps, I will show the pieces of code I have that are working. Thanks to everyone for any help on this matter, much appreciated.
In summary, I would like to,
-Save each sheet (1-8) as a new workbook into a folder using value of A1 on each sheet as the filename
-Load those 8 new workbooks as an attachment in Outlook email to send
Here are some pieces of code I have that are working,
The following loads a single sheet in outlook with the filename "TempRangeForEmail",
I have been unable to get multiple files to attach, or get the filenames right.
Sub SEND_TO_OUTLOOK()
'SENDS SINGLE SHEET AS ATTACHMENT IN OUTLOOK
'VARIABLES
Dim OLApp As Outlook.Application
Dim OLMail As Object
'SAVES TO NEW WORKBOOK
Sheets("1").Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\TempRangeForEmail.xlsx"
'STARTS OUTLOOK
Set OLApp = New Outlook.Application
Set OLMail = OLApp.CreateItem(0)
OLApp.Session.Logon
With OLMail
.To = "WHOEVER.com"
.CC = ""
.BCC = ""
.Subject = "LOADS INTO SUBJECT LINE CORRECTLY"
.Body = "LOADS INTO BODY OF EMAIL CORRECTLY"""
.Attachments.Add (ThisWorkbook.Path & "\TempRangeForEmail.xlsx")
.Display
'CHANGE TO SEND ONCE WORKING
End With
ActiveWorkbook.Close SaveChanges:=True
Kill ThisWorkbook.Path & "\TempRangeForEmail.xlsx"
'Memory Cleanup
Set OLMail = Nothing
Set OLApp = Nothing
End Sub
And this code will save each sheet correctly with the correct filename into folder but I am unsure how to load these into Outlook as attachments, Also my apologies, I realize this code is unneccesarily long, which again points to my limited knowledge of VBA. But it was working.
To further confuse i know I mentioned cell A1 above, but this will be shown as S33 below.
Sub SAVES_TO_FOLDER() 'SAVES SHEETS TO FOLDER AS NEW WORKBOOKS
Application.ScreenUpdating = False
Dim fName As String
'SHEET 1
fName = Sheets("1").Range("S33").Value
Sheets("1").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 2
fName = Sheets("2").Range("S33").Value
Sheets("2").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 3
fName = Sheets("3").Range("S33").Value
Sheets("3").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 4
fName = Sheets("4").Range("S33").Value
Sheets("4").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 5
fName = Sheets("5").Range("S33").Value
Sheets("5").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 6
fName = Sheets("6").Range("S33").Value
Sheets("6").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 7
fName = Sheets("7").Range("S33").Value
Sheets("7").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
'SHEET 8
fName = Sheets("8").Range("S33").Value
Sheets("8").Copy
With ActiveWorkbook
'DESTINATION FOLDER
.SaveAs "S:\MY FOLDERS LOCATION" & fName
.Close
End With
Application.CutCopyMode = False
End Sub
And versions I am using,
Microsoft® Outlook® for Microsoft 365 MSO (Version 2204 Build 16.0.15128.20158) 64-bit
Microsoft® Excel® for Microsoft 365 MSO (Version 2204 Build 16.0.15128.20158) 64-bit
Thank you all for your time