Need help is Error on Application.Transpose

0

Sub SendEmailShortSyntax()

    Dim outlookApp As Object

    Dim emailItem As Object

    Dim emailSubject As String

    Dim emailBody As String

    Dim emailTo As String

    Dim emailList As Variant

    Set outlookApp = CreateObject("outlook.Application")

    Set emailItem = outlookApp.CreateItem(0)

    'TBLEmailList[Email1]

  emailList = Application.Transpose(ThisWorkbook.Worksheets("Email Sheet").Range("TBLEmailList[Email1]").Value)

    emailTo = Join(emailList, ";")

    emailSubject = "Re-registration at IES has not been completed yet."

    emailBody = "Dear parent/guardian of:  replace_name_here." & vbNewLine & _

    With emailItem

        .To = emailTo

        .CC = ""

        .BCC = ""

        .Subject = emailSubject

        .Body = emailBody

Answer
Discuss

Discussion

Hi Tom and welcome to the Forum

To get an answer, you first need to ask a question! While we might guess that your code fails at the lines in bold, we can't see possible causes in your workbook (e.g. in the .Transpose line, do the named sheet, table and column header exist?)

Also you code would produce a single email addressed to all parents- is that good from data privacy and compatible with your (incomplete) line "emailBody = "Dear parent/guardian of:  replace_name_here." & vbNewLine"?

Please EDIT your original message to clarify what does/ does not happen,what you want to happen and (preferably) attach a representative Excel file.
John_Ru (rep: 1557) Jul 19, '21 at 3:42 am
Add to Discussion

Answers

0

Tom

Your line emailList = Application.Transpose.. should work (if Email1 is a column header in the named table and named sheet) but  I suggest you avoid this appraoch which sends a single email addressed to all email addresses. Better in my opinion to send an email per parent.

If your table has a column header named "Student" then this modified code will create an email per student. It will send them from Outlook once you comment out the .Display line and uncomment the .Send line. Things to change (possibly) are in bold below:

Sub IndivEmails()

Dim outlookApp As Object
Dim emailItem As Object
Dim emailSubject As String, emailBody As String
Dim emailTo As String, emailList As Variant
Dim n As Long 'varibble for row in table

Set outlookApp = CreateObject("outlook.Application")

With Worksheets("Email Sheet")

For n = 1 To .Range("TBLEmailList[Email1]").Count

    ' send an individual email

    emailSubject = "Re-registration at IES has not been completed yet."
    ' use this copperplate text (edit to suit before running macro)
    emailBody = "Kindly complete registration of your student before 30 July 2021. You can do so online at online at " _
        & "registration @ies.com" & " or by return of a paper registration form." & vbNewLine _
        & "If you have any questions, please call ####### on ######## during office hours."
    ' add student name from table column
    emailBody = "Dear parent/guardian of " & .Range("TBLEmailList[Student]").Cells(n) & vbNewLine & vbNewLine & emailBody

    emailTo = .Range("TBLEmailList[Email1]").Cells(n)

    Set emailItem = outlookApp.CreateItem(0)

    With emailItem

        .To = emailTo
        .CC = ""
        .BCC = ""
        .Subject = emailSubject
        .Body = emailBody
        ' ### comment out Send during testing; uncomment and comment out Display for real send
        .Display
        '.Send

    End With
Next n
' say something happened
MsgBox n - 1 & " individual emails created/sent"
End With

End Sub
Hope this helps. Let me know please.
Discuss


Answer the Question

You must create an account to use the forum. Create an Account or Login