Vlookup in VBA based on workbook name to outlook .TO= field

diabloxx

New Member
Joined
Jan 21, 2012
Messages
16
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:
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
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Forum statistics

Threads
1,215,087
Messages
6,123,046
Members
449,092
Latest member
ikke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top