Lost in Code - Help Requested - Mass Emailing

armstrongh

New Member
Joined
May 30, 2019
Messages
3
Ladies and Gentlemen of the Microsoft Excel VBA universe, good afternoon. In advance I apologized for the long post but I feel it’s important to clarify a few things. My name is Hal and I am responsible for contacting people for employment opportunities. Basically I am an employment recruiter. About a year and a half ago I began to think that there had to be a better, more efficient way of reaching out to people. We currently have a standard of 25 telephone calls an hour, 30 text an hour, 15 emails an hour (not all at the same time of course).

I started to research and found out that I could essentially send text messages from my email and when people text back it comes to my email inbox. A buddy of mine assisted in automating the process and it has worked great. Over the last year, we have tweaked this and modified that to have a really good system for sending out personalized mass emails and text. I have gotten to the point now where I can easily reach 10,000 people in a day via text and email. In full transparency, I am not a very smart person when it comes to this stuff. I am more of a handy man and my buddy is the smart techy guy. So we have relied on each other to do the stuff the other couldn’t do.

My dilemma comes in the form that it has caused me to become successful and I have been asked to teach my co-workers how to do what I have been able to do. While the process is fairly simple once you have done it a few times, we all know that upon the first bad experience you’ll not want to use a product again. So I am trying to make this as simple for the user as possible which means that the internal workings that nobody will ever see is complicated.

Here are a couple rules that must be followed by my employer:

1) We are only able to access our database via work computers.

2) We are not allowed to download programs or add-ins to assist in making life easier

So this leaves me with utilizing Microsoft Excel, Word and Outlook to do my mass prospecting. Again not a problem for me but others might have some issues. Below is what my program currently looks like and how I use it.


There are three methods we can utilize to pull specific list, each have their purpose and benefit.

1) Lead List (Sorry about the pic) (Up to 50 profiles per file)


2) Search Results (Sorry about the pic) (Up to 50 profiles per file)


3) myMailMerge (Sorry about the pic) (Up to 300 profiles per file)
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
VBA Side of the house

Module: Clear All
Code:
Sub btn_ClearAll()
Range("A3", Range("T" & ActiveSheet.UsedRange.Rows.Count)).Clear
End Sub

Module: Import_LeadList
Code:
Sub btn_ImportLeadList()
    OpenFiles
End Sub
 
Sub OpenFiles()
    Call SpeedOn
   
    'Declare a variable as a FileDialog object.
    Dim fd As FileDialog
    Dim path As String
    Dim w As Workbook
    Dim w1 As Workbook
    Dim rowIndex As Integer
    Dim runStart As Single
    Dim runEnd As Single
   
    'Init rowIndex
    rowIndex = 3
    'This WorkBook
    Set w = ThisWorkbook
   
    'Create a FileDialog object as a File Picker dialog box.
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
   
    'Declare a variable to contain the path
    'of each selected item. Even though the path is a String,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim vrtSelectedItem As Variant
 
    'Use a With...End With block to reference the FileDialog object.
    With fd
 
        'Use the Show method to display the File Picker dialog box and return the user's action.
        'The user pressed the action button.
        If .Show = -1 Then
 
            'Step through each string in the FileDialogSelectedItems collection.
            For Each vrtSelectedItem In .SelectedItems
 
                'vrtSelectedItem is a String that contains the path of each selected item.
                'You can use any file I/O functions that you want to work with this path.
                'This example simply displays the path in a message box.
                'MsgBox "The path is: " & vrtSelectedItem
                'OpenExcelFile (vrtSelectedItem)
                'MsgBox rowIndex
                Set w1 = OpenFile(vrtSelectedItem)
               
                'Phone Number
                'w1.Sheets("LeadList").Range("G2", Range("G" & Rows.Count).End(xlUp)).Copy
                w1.Sheets("LeadList").Range("G2", Range("G" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("G" & rowIndex).PasteSpecial
               
                'FullName
                w1.Sheets("LeadList").Range("F2", Range("F" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("B" & rowIndex).PasteSpecial
               
                'Email
                w1.Sheets("LeadList").Range("H2", Range("H" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("L" & rowIndex).PasteSpecial
               
                'Last Contact
                w1.Sheets("LeadList").Range("D2", Range("D" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("A" & rowIndex).PasteSpecial
               
                'Incremement rowIndex to start next file
                rowIndex = rowIndex + ActiveSheet.UsedRange.Rows.Count - 1
                w1.Close
               
            Next vrtSelectedItem
        'The user pressed Cancel.
        Else
        End If
    End With
 
    'Set the object variable to Nothing.
    Set fd = Nothing
   
    Call LeadList_format
   
    Call SpeedOff
   
    Worksheets("Text and Email Wizard").Columns("A:T").Columns.AutoFit
   
    MsgBox ("Import and Format Complete")
End Sub
 
Function OpenFile(path As Variant) As Workbook
    Dim w As Workbook
   
    Set w = Workbooks.Open(path)
    Set OpenFile = w
End Function
 
Sub OpenExcelFile(path As String)
    Dim w1 As Workbook
    Dim w As Workbook
   
    Set w = ThisWorkbook
    Set w1 = Workbooks.Open(path)
   
    'Phone Number
    w1.Sheets("LeadList").Range("G2", Range("G" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("G3").PasteSpecial
   
    'FullName
    w1.Sheets("LeadList").Range("F2", Range("F" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("B3").PasteSpecial
   
    'Email
    w1.Sheets("LeadList").Range("H2", Range("H" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("L3").PasteSpecial
   
    'Last Contact
    w1.Sheets("LeadList").Range("D2", Range("D" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("A3").PasteSpecial
   
    w1.Close
End Sub
 
Sub LeadList_format()
    Dim r As Range
    Dim SMSRange As Range
   
   
    'Get range of name columns
    Set r = ThisWorkbook.Sheets("Text and Email Wizard").Range("A3", Range("T" & ActiveSheet.UsedRange.Rows.Count))
    Set SMSRange = ThisWorkbook.Sheets("DataValues").Range("B3:C10")
   
    'Iterate through name columns
    For Each rw In r.Rows
        Dim last, first, middle As String
        Dim mid() As String
        'Initialize name variables
        first = ""
        middle = ""
        last = ""
       
        'Get first/last array values
        last = Split(rw.Cells(1, 2), ",")(0)
        first = Split(rw.Cells(1, 2), ",")(1)
       
        'Split firstname by space in case of middle name
        mid = Split(first, " ")
       
        'If mid variable has more than one element there is a middle name
        If UBound(mid) > 1 Then
            Dim fm() As String
            fm = Split(first, " ")
            first = fm(1)
            middle = fm(2)
        End If
       
        'Populate name values
        rw.Cells(1, 4) = UpperCaseFirstLetter(first)
        rw.Cells(1, 3) = UpperCaseFirstLetter(last)
        rw.Cells(1, 5) = UpperCaseFirstLetter(middle)
        rw.Cells(1, 12) = LCase(rw.Cells(1, 12))
       
        SetSMSColumns rw, SMSRange
    Next rw
   
    Worksheets("Text and Email Wizard").Columns("A:T").Columns.AutoFit
   
End Sub
 
Function UpperCaseFirstLetter(ByVal s As String) As String
    Dim result As String
    If s <> "" Then
        s = Trim(s)
        result = UCase(Left(s, 1)) & LCase(Right(s, Len(s) - 1))
    Else
        result = s
    End If
   
    UpperCaseFirstLetter = result
   
End Function
 
Sub SetSMSColumns(r As Variant, smsValues As Range)
     Dim phoneNumber As String
     Dim vzw, tmobile, att, metropcs, sprint, _
     boost, cricket, virgin As String
    
     vzw = Replace(smsValues(1, 2), "\", "")
     tmobile = Replace(smsValues(2, 2), "\", "")
     att = Replace(smsValues(3, 2), "\", "")
     metropcs = Replace(smsValues(4, 2), "\", "")
     sprint = Replace(smsValues(5, 2), "\", "")
     boost = Replace(smsValues(6, 2), "\", "")
     cricket = Replace(smsValues(7, 2), "\", "")
     virgin = Replace(smsValues(8, 2), "\", "")
    
     phoneNumber = r.Cells(1, 7)
     phoneNumber = Replace(phoneNumber, "-", "")
     phoneNumber = Replace(phoneNumber, "(", "")
     phoneNumber = Replace(phoneNumber, ")", "")
    
     If phoneNumber <> "" Then
        r.Cells(1, 13) = phoneNumber + vzw
        r.Cells(1, 14) = phoneNumber + tmobile
        r.Cells(1, 15) = phoneNumber + att
        r.Cells(1, 16) = phoneNumber + metropcs
        r.Cells(1, 17) = phoneNumber + sprint
        r.Cells(1, 18) = phoneNumber + boost
        r.Cells(1, 19) = phoneNumber + cricket
        r.Cells(1, 20) = phoneNumber + virgin
     End If
End Sub

Module: Import_myMailMerge
Code:
Sub btn_ImportmyMailMerge()
    OpenFiles
End Sub
 
Sub OpenFiles()
    Call SpeedOn
   
    'Declare a variable as a FileDialog object.
    Dim fd As FileDialog
    Dim path As String
    Dim w As Workbook
    Dim w1 As Workbook
    Dim rowIndex As Integer
    Dim runStart As Single
    Dim runEnd As Single
   
    'Init rowIndex
    rowIndex = 3
    'This WorkBook
    Set w = ThisWorkbook
   
    'Create a FileDialog object as a File Picker dialog box.
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
   
    'Declare a variable to contain the path
    'of each selected item. Even though the path is a String,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim vrtSelectedItem As Variant
 
    'Use a With...End With block to reference the FileDialog object.
    With fd
 
        'Use the Show method to display the File Picker dialog box and return the user's action.
        'The user pressed the action button.
        If .Show = -1 Then
 
            'Step through each string in the FileDialogSelectedItems collection.
            For Each vrtSelectedItem In .SelectedItems
 
                'vrtSelectedItem is a String that contains the path of each selected item.
                'You can use any file I/O functions that you want to work with this path.
                'This example simply displays the path in a message box.
                'MsgBox "The path is: " & vrtSelectedItem
                'OpenExcelFile (vrtSelectedItem)
                'MsgBox rowIndex
                Set w1 = OpenFile(vrtSelectedItem)
               
                'First Name
                'w1.Sheets("myMailMerge").Range("A2", Range("A" & Rows.Count).End(xlUp)).Copy
                w1.Sheets("myMailMerge").Range("A2", Range("A" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("D" & rowIndex).PasteSpecial
               
                'Last Name
                w1.Sheets("myMailMerge").Range("B2", Range("B" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("C" & rowIndex).PasteSpecial
               
                'Address
                w1.Sheets("myMailMerge").Range("C2", Range("C" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("H" & rowIndex).PasteSpecial
               
                'City
                w1.Sheets("myMailMerge").Range("D2", Range("D" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("I" & rowIndex).PasteSpecial
               
                'State
                w1.Sheets("myMailMerge").Range("E2", Range("E" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("J" & rowIndex).PasteSpecial
               
                'Zip
                w1.Sheets("myMailMerge").Range("F2", Range("F" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("K" & rowIndex).PasteSpecial
               
                'Incremement rowIndex to start next file
                rowIndex = rowIndex + ActiveSheet.UsedRange.Rows.Count - 1
                w1.Close
               
            Next vrtSelectedItem
        'The user pressed Cancel.
        Else
        End If
    End With
 
    'Set the object variable to Nothing.
    Set fd = Nothing
   
    Call myMailMerge_format
   
    Call SpeedOff
   
    Worksheets("Text and Email Wizard").Columns("A:T").Columns.AutoFit
   
    MsgBox ("Import and Format Complete")
End Sub
 
Function OpenFile(path As Variant) As Workbook
    Dim w As Workbook
   
    Set w = Workbooks.Open(path)
    Set OpenFile = w
End Function
 
Sub OpenExcelFile(path As String)
    Dim w1 As Workbook
    Dim w As Workbook
   
    Set w = ThisWorkbook
    Set w1 = Workbooks.Open(path)
   
    'First Name
    w1.Sheets("myMailMerge").Range("A2", Range("A" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("D3").PasteSpecial
   
    'Last Name
    w1.Sheets("myMailMerge").Range("B2", Range("B" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("C3").PasteSpecial
   
    'Address
    w1.Sheets("myMailMerge").Range("C2", Range("C" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("H3").PasteSpecial
   
    'City
    w1.Sheets("myMailMerge").Range("D2", Range("D" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("I3").PasteSpecial
   
    'State
    w1.Sheets("myMailMerge").Range("E2", Range("E" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("J3").PasteSpecial
   
    'Zip
    w1.Sheets("myMailMerge").Range("F2", Range("F" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("K3").PasteSpecial
   
    w1.Close
End Sub
 
Sub myMailMerge_format()
    Dim r As Range
    Dim SMSRange As Range
   
   
    'Get range of name columns
    Set r = ThisWorkbook.Sheets("Text and Email Wizard").Range("A3", Range("T" & ActiveSheet.UsedRange.Rows.Count))
    Set SMSRange = ThisWorkbook.Sheets("DataValues").Range("B3:C10")
   
    'Iterate through name columns
    For Each rw In r.Rows
        Dim last, first, middle As String
        Dim mid() As String
        'Initialize name variables
        first = ""
        middle = ""
        last = ""
       
        'Get first/last array values
        'last = Split(rw.Cells(1, 2), ",")(0)
        'first = Split(rw.Cells(1, 2), ",")(1)
       
        'Split firstname by space in case of middle name
        mid = Split(first, " ")
       
        'If mid variable has more than one element there is a middle name
        If UBound(mid) > 1 Then
            Dim fm() As String
            fm = Split(first, " ")
            first = fm(1)
            middle = fm(2)
        End If
       
        'Populate name values
        rw.Cells(1, 4) = UCase(rw.Cells(1, 4).Value)
        rw.Cells(1, 3) = UCase(rw.Cells(1, 3).Value)
        rw.Cells(1, 5) = UCase(rw.Cells(1, 5).Value)
       
    Next rw
   
    Worksheets("Text and Email Wizard").Columns("A:T").Columns.AutoFit
   
End Sub
 
Function UpperCaseFirstLetter(ByVal s As String) As String
    Dim result As String
    If s <> "" Then
        s = Trim(s)
        result = UCase(Left(s, 1)) & LCase(Right(s, Len(s) - 1))
    Else
        result = s
    End If
   
    UpperCaseFirstLetter = result
   
End Function

Module: Import_SearchResults

Code:
Sub btn_ImportSearchResults()
    OpenFiles
End Sub
 
Sub OpenFiles()
    Call SpeedOn
   
    'Declare a variable as a FileDialog object.
    Dim fd As FileDialog
    Dim path As String
    Dim w As Workbook
    Dim w1 As Workbook
    Dim rowIndex As Integer
    Dim runStart As Single
    Dim runEnd As Single
   
    'Init rowIndex
    rowIndex = 3
    'This WorkBook
    Set w = ThisWorkbook
   
    'Create a FileDialog object as a File Picker dialog box.
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
   
    'Declare a variable to contain the path
    'of each selected item. Even though the path is a String,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim vrtSelectedItem As Variant
 
    'Use a With...End With block to reference the FileDialog object.
    With fd
 
        'Use the Show method to display the File Picker dialog box and return the user's action.
        'The user pressed the action button.
        If .Show = -1 Then
 
            'Step through each string in the FileDialogSelectedItems collection.
            For Each vrtSelectedItem In .SelectedItems
 
                'vrtSelectedItem is a String that contains the path of each selected item.
                'You can use any file I/O functions that you want to work with this path.
                'This example simply displays the path in a message box.
                'MsgBox "The path is: " & vrtSelectedItem
                'OpenExcelFile (vrtSelectedItem)
                'MsgBox rowIndex
                Set w1 = OpenFile(vrtSelectedItem)
               
                'Phone Number
                'w1.Sheets("SearchResults").Range("D2", Range("D" & Rows.Count).End(xlUp)).Copy
                w1.Sheets("SearchResults").Range("D2", Range("D" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("G" & rowIndex).PasteSpecial
               
                'FullName
                w1.Sheets("SearchResults").Range("H2", Range("H" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("B" & rowIndex).PasteSpecial
               
                'Email
                w1.Sheets("SearchResults").Range("J2", Range("J" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("L" & rowIndex).PasteSpecial
               
                'Last Contact
                w1.Sheets("SearchResults").Range("F2", Range("F" & ActiveSheet.UsedRange.Rows.Count)).Copy
                w.Sheets("Text and Email Wizard").Range("A" & rowIndex).PasteSpecial
               
                'Incremement rowIndex to start next file
                rowIndex = rowIndex + ActiveSheet.UsedRange.Rows.Count - 1
                w1.Close
               
            Next vrtSelectedItem
        'The user pressed Cancel.
        Else
        End If
    End With
 
    'Set the object variable to Nothing.
    Set fd = Nothing
   
    Call SearchResults_format
   
    Call SpeedOff
   
    Worksheets("Text and Email Wizard").Columns("A:T").Columns.AutoFit
   
    MsgBox ("Import and Format Complete")
End Sub
 
Function OpenFile(path As Variant) As Workbook
    Dim w As Workbook
   
    Set w = Workbooks.Open(path)
    Set OpenFile = w
End Function
 
Sub OpenExcelFile(path As String)
    Dim w1 As Workbook
    Dim w As Workbook
   
    Set w = ThisWorkbook
    Set w1 = Workbooks.Open(path)
   
    'Phone Number
    w1.Sheets("SearchResults").Range("D2", Range("D" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("G3").PasteSpecial
   
    'FullName
    w1.Sheets("SearchResults").Range("H2", Range("H" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("B3").PasteSpecial
   
    'Email
    w1.Sheets("SearchResults").Range("J2", Range("J" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("L3").PasteSpecial
   
    'Last Contact
    w1.Sheets("SearchResults").Range("F2", Range("F" & Rows.Count).End(xlUp)).Copy
    w.Sheets("Text and Email Wizard").Range("A3").PasteSpecial
   
    w1.Close
End Sub
 
Sub SearchResults_format()
    Dim r As Range
    Dim SMSRange As Range
   
   
    'Get range of name columns
    Set r = ThisWorkbook.Sheets("Text and Email Wizard").Range("A3", Range("T" & ActiveSheet.UsedRange.Rows.Count))
    Set SMSRange = ThisWorkbook.Sheets("DataValues").Range("B3:C10")
   
    'Iterate through name columns
    For Each rw In r.Rows
        Dim last, first, middle As String
        Dim mid() As String
        'Initialize name variables
        first = ""
        middle = ""
        last = ""
       
        'Get first/last array values
        first = Split(rw.Cells(1, 2), " ")(0)
        last = Split(rw.Cells(1, 2), " ")(1)
       
        'Split firstname by space in case of middle name
        mid = Split(first, " ")
       
        'If mid variable has more than one element there is a middle name
        If UBound(mid) > 1 Then
            Dim fm() As String
            fm = Split(first, " ")
            first = fm(1)
            middle = fm(2)
        End If
       
        'Populate name values
        rw.Cells(1, 4) = UpperCaseFirstLetter(first)
        rw.Cells(1, 3) = UpperCaseFirstLetter(last)
        rw.Cells(1, 5) = UpperCaseFirstLetter(middle)
        rw.Cells(1, 12) = LCase(rw.Cells(1, 12))
       
        SetSMSColumns rw, SMSRange
    Next rw
   
    Worksheets("Text and Email Wizard").Columns("A:T").Columns.AutoFit
   
End Sub
 
Function UpperCaseFirstLetter(ByVal s As String) As String
    Dim result As String
    If s <> "" Then
        s = Trim(s)
        result = UCase(Left(s, 1)) & LCase(Right(s, Len(s) - 1))
    Else
        result = s
    End If
   
    UpperCaseFirstLetter = result
   
End Function
 
Sub SetSMSColumns(r As Variant, smsValues As Range)
     Dim phoneNumber As String
     Dim vzw, tmobile, att, metropcs, sprint, _
     boost, cricket, virgin As String
    
     vzw = Replace(smsValues(1, 2), "\", "")
     tmobile = Replace(smsValues(2, 2), "\", "")
     att = Replace(smsValues(3, 2), "\", "")
     metropcs = Replace(smsValues(4, 2), "\", "")
     sprint = Replace(smsValues(5, 2), "\", "")
     boost = Replace(smsValues(6, 2), "\", "")
     cricket = Replace(smsValues(7, 2), "\", "")
     virgin = Replace(smsValues(8, 2), "\", "")
    
     phoneNumber = r.Cells(1, 7)
     phoneNumber = Replace(phoneNumber, "-", "")
     phoneNumber = Replace(phoneNumber, "(", "")
     phoneNumber = Replace(phoneNumber, ")", "")
    
     If phoneNumber <> "" Then
        r.Cells(1, 13) = phoneNumber + vzw
        r.Cells(1, 14) = phoneNumber + tmobile
        r.Cells(1, 15) = phoneNumber + att
        r.Cells(1, 16) = phoneNumber + metropcs
        r.Cells(1, 17) = phoneNumber + sprint
        r.Cells(1, 18) = phoneNumber + boost
        r.Cells(1, 19) = phoneNumber + cricket
        r.Cells(1, 20) = phoneNumber + virgin
     End If
End Sub

Module: Speed
Code:
Sub SpeedOn()
    'Turns off the time wasters
    With Application
        Application.Calculation = xlCalculationManual
        Application.ScreenUpdating = False
        Application.DisplayStatusBar = False
        Application.EnableEvents = False
    End With
End Sub
 
Sub SpeedOff()
    'Turns on the time wasters
    With Application
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        Application.DisplayStatusBar = True
        Application.EnableEvents = True
    End With
End Sub
So what I want to be able to do it utilized only Excel and Outlook. I also would like to reduce the amount of steps required to get things going.
1) An “Import” button to handle all three types of files to be uploaded and formatted.
2) A “Clear All” button to handle removing upload information when complete.
3) A “Start Email” and “Start Text” button to take care of my Text and Email campaigns.
So my question for the group is how do I combine all three of my import and format processes into one process to make it where the user doesn’t have to decide/remember/think of the type of file they downloaded?
And
How do I fix my email and Text to handle automatically emailing all addresses for a specific person before moving on to the next profile?
Below is the addition of the Message Tab and the coding to go with it.

Module: Send_Email
Code:
Sub btn_SendEmail()
    SendMassEmail
End Sub
 
Sub SendEmails(what_address As String, subject_line As String, mail_body As String)
 
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
 
    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)
   
    olMail.To = what_address
    olMail.Subject = subject_line
    olMail.Body = mail_body
    olMail.Send
       
End Sub
Sub SendMassEmail()
 
row_number = 1
 
Do
DoEvents
    row_number = row_number + 1
    Dim mail_body_message As String
    Dim full_name As String
    Dim promo_code As String
   
    mail_body_message = w.Sheets("Message").Range("B5")
    full_name = w.Sheets("Text and Email Wizard").Range("D" & row_number) & " " & w.Sheets("Text and Email Wizard").Range("C" & row_number)
    mail_body_message = Replace(mail_body_message, "replace_name_here", full_name)
        MsgBox mail_body_message
    'Need to use the first record name and all text address until complete then move to next record
    'Call SendEmail(w.sheets("Text and Email Wizard").Range("M":"T" & row_number), w.sheets("Message").Range("C3"), mail_body_message)
   
'Loop Until = Last Row
 
MsgBox "Mass Email Complete!"
   
End Sub
 
Upvote 0
this is the idea... your post is a little much for anyone to digest who isnt familiar with this project

Code:
Sub Main()
    Dim somethingToRemember As Whatever
    (set) somethingToRemember = TheFirstFunction()
    call TheSecondFuntion(somethingToRemember)
    call TheThirdFuntion(somethingToRemember)
End Sub

you could even throw all the code into one subroutine
 
Last edited:
Upvote 0
this is the idea... your post is a little much for anyone to digest who isnt familiar with this project

Yeah sorry about that. At first I was going to approach the "Import" problem with IF Statements but like I said before... definitely not very smart when it comes to this code stuff. My hats off to you guys who understand any of this.
 
Upvote 0

Forum statistics

Threads
1,214,651
Messages
6,120,738
Members
448,988
Latest member
BB_Unlv

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