So I have some questions as I am not too familiar with writing loops. I have a Macro setup on Outlook that I run which will take a selected "popped out" email, copy the body of the email, open a workbook, and run a macro within said workbook.
After writing this code I found out the application of how it will be used was much different than expected. I thought these emails would trickle in during the day here and there, what I found out afterwards is we receive around 100 of these emails overnight that need this process done. Now I am trying to work around a way to be able to select multiple emails in Outlook and have this process run.
I would start by having the user select all the emails required, right click to Open, and have all the windows populate on their screen. I would think if I added code to close the current email at the bottom, then loop this code, it would run through every email pop up until they were all gone.
I wouldn't need to identify each email that is popped open because they way it runs is it find the last one selected, so once that one is deleted, another one would be assigned the last one selected, correct?
I know this won't be the most efficient way to code it either as I am opening, editing, closing, and saving an excel work book each time rather than opening it once, closing it once, and saving it once. Right now I am trying to get this running and whoever is using it can go make some coffee for a minute.
Code below:
Sub CopyAll_and_openSite()
Dim objApp
Dim objInsp
Dim colCB
Dim objCBB
On Error Resume Next
Set objApp = GetObject("", "Outlook.Application")
If objApp Is Nothing Then
Set objApp = Application.CreateObject("Outlook.Application")
End If
Set objInsp = objApp.ActiveInspector
If TypeName(objInsp) = "Nothing" Then
MsgBox "No inspector window found"
Exit Sub
Else
Set colCB = objInsp.CommandBars
Set objCBB = colCB.FindControl(, 354) ' Reply
objCBB.Execute
End If
Set objCBB = Nothing
Set colCB = Nothing
Set objInsp = Nothing
Set objApp = GetObject("", "Outlook.Application")
If objApp Is Nothing Then
Set objApp = Application.CreateObject("Outlook.Application")
End If
Set objInsp = objApp.ActiveInspector
If TypeName(objInsp) = "Nothing" Then
MsgBox "No inspector window found"
Exit Sub
Else
Set colCB = objInsp.CommandBars
Set objCBB = colCB.FindControl(, 3634) ' clear clipboard
objCBB.Execute
Set objCBB = colCB.FindControl(, 756) ' select all
objCBB.Execute
Set objCBB = colCB.FindControl(, 19) ' copy
objCBB.Execute
Set objCBB = colCB.FindControl(, 2011) ' Close email
objCBB.Execute
End If
Set objCBB = Nothing
Set colCB = Nothing
Set objInsp = Nothing
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open ("\\TMAJAMES\Users\Public\Documents\AT&T LTL\ATT-LTL.xlsm")
appExcel.Visible = True
appExcel.Run "'ATT-LTL.xlsm'!transfer"
End Sub
After writing this code I found out the application of how it will be used was much different than expected. I thought these emails would trickle in during the day here and there, what I found out afterwards is we receive around 100 of these emails overnight that need this process done. Now I am trying to work around a way to be able to select multiple emails in Outlook and have this process run.
I would start by having the user select all the emails required, right click to Open, and have all the windows populate on their screen. I would think if I added code to close the current email at the bottom, then loop this code, it would run through every email pop up until they were all gone.
I wouldn't need to identify each email that is popped open because they way it runs is it find the last one selected, so once that one is deleted, another one would be assigned the last one selected, correct?
I know this won't be the most efficient way to code it either as I am opening, editing, closing, and saving an excel work book each time rather than opening it once, closing it once, and saving it once. Right now I am trying to get this running and whoever is using it can go make some coffee for a minute.
Code below:
Sub CopyAll_and_openSite()
Dim objApp
Dim objInsp
Dim colCB
Dim objCBB
On Error Resume Next
Set objApp = GetObject("", "Outlook.Application")
If objApp Is Nothing Then
Set objApp = Application.CreateObject("Outlook.Application")
End If
Set objInsp = objApp.ActiveInspector
If TypeName(objInsp) = "Nothing" Then
MsgBox "No inspector window found"
Exit Sub
Else
Set colCB = objInsp.CommandBars
Set objCBB = colCB.FindControl(, 354) ' Reply
objCBB.Execute
End If
Set objCBB = Nothing
Set colCB = Nothing
Set objInsp = Nothing
Set objApp = GetObject("", "Outlook.Application")
If objApp Is Nothing Then
Set objApp = Application.CreateObject("Outlook.Application")
End If
Set objInsp = objApp.ActiveInspector
If TypeName(objInsp) = "Nothing" Then
MsgBox "No inspector window found"
Exit Sub
Else
Set colCB = objInsp.CommandBars
Set objCBB = colCB.FindControl(, 3634) ' clear clipboard
objCBB.Execute
Set objCBB = colCB.FindControl(, 756) ' select all
objCBB.Execute
Set objCBB = colCB.FindControl(, 19) ' copy
objCBB.Execute
Set objCBB = colCB.FindControl(, 2011) ' Close email
objCBB.Execute
End If
Set objCBB = Nothing
Set colCB = Nothing
Set objInsp = Nothing
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open ("\\TMAJAMES\Users\Public\Documents\AT&T LTL\ATT-LTL.xlsm")
appExcel.Visible = True
appExcel.Run "'ATT-LTL.xlsm'!transfer"
End Sub
