OK, first of all, a HUGE thank you to Dominec for getting me what i thought i needed! as it turns out, Just when i thought i was finished, opportunity came knocking and i need more help.
I have a great code for emailing all files in a directroy as attachments in individual outlook emails (thanks again to Dominec). I will post that code.
What i'd like to do now is somehow have the code look at a table and find the name of the file (A1) , then return in the To: field of my outlook the email address in B1.
I have 70+ workbooks in the folder each one with a different name.
this is on an XP with Office 2007/2010
i would keep an updated list in the current workbook that holds this code:
I have a great code for emailing all files in a directroy as attachments in individual outlook emails (thanks again to Dominec). I will post that code.
What i'd like to do now is somehow have the code look at a table and find the name of the file (A1) , then return in the To: field of my outlook the email address in B1.
I have 70+ workbooks in the folder each one with a different name.
this is on an XP with Office 2007/2010
i would keep an updated list in the current workbook that holds this code:
Code:
Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
Sub AD_Report_Card()
Dim OutApp As Object
Dim OutMail As Object
Dim strMyFolder As String
Dim strFile As String
Dim strBody As String
Dim SigString As String
Dim Signature As String
Dim MyDate As String
Dim MyDay As String
Dim MyMonth As String
Dim MyYear As String
MyYear = Year(Date)
MyMonth = Month(Date)
If Month(Date) < 10 Then LastMonth = "0" & Month(Date)
MyDay = Day(Date)
If Day(Date) < 10 Then MyDay = "0" & Day(Date)
MyDate = MyYear & "-" & MyMonth & "-" & MyDay
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please select a folder..."
.InitialFileName = Application.DefaultFilePath & "\" 'change the default folder accordingly
.Show
If .SelectedItems.Count > 0 Then
strMyFolder = .SelectedItems(1) & "\"
Else
Exit Sub
End If
End With
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
strBody = "Good afternoon, " & "<br><br>" & _
"Attached is your Inventory Report Card through the month of " & Sheets("Sheet1").Range("O1").Value & "<br><br>" & _
"The Inventory Report Card is your tool to monitor inventory management issues in your area, and to assist you in performance management. It includes financial and compliance penalty quantities as well as short-dated incentive (SPIF) quantities by individual representative in each region within your area. Quantities reported represent total penalties and instances, along with total reversals, that have been applied during the current calendar year." & "<br><br>" & _
"Please note there are several tabs with the following information:" & "<br><br>" & _
"<li>Monthly Updates displays each rep month by month and also provides where they ended up last year. If items from 2010 are reconciled this year, they will be reflected in the 2010 info on this tab.</li></indent>" & "<br>" & _
"<li>Assessment Details displays the cumulative details for the current calendar year by rep and penalty type, including reversals. </li>" & "<br>" & _
"<li>Total Compliance Chart is a visual chart of how each region is doing in terms of compliance instances</li>" & "<br><br>" & _
"Regional and Vice President Inventory Report Cards will be sent to your Regional Managers, Vice Presidents and Senior Vice Presidents respectively. " & "<br><br>" & _
"If you have feedback, comments, or suggestions about the data included in your Inventory Report Card or other inventory management issues, feel free to contact me directly." & "<br><br>" & _
"Thank you," & "<br><br>"
SigString = "C:\Documents and Settings\" & Environ("username") & _
"\Application Data\Microsoft\Signatures\MySig.HTM" 'Change the filename for the signature accordingly
'SigString = "C:\Users\" & Environ("username") & _
"\AppData\Roaming\Microsoft\Signatures\James.txt"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
strFile = Dir(strMyFolder & "*.xls") 'change the file extension acccordingly
Do While Len(strFile) > 0
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = Sheets("Sheet1").Range("O1").Value & " Inventory Report Card - " & strFile
.HTMLBody = strBody & vbNewLine & vbNewLine & Signature
.Attachments.Add strMyFolder & strFile
.Display
'Send
End With
On Error GoTo 0
strFile = Dir
Loop
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub