简体   繁体   中英

excel send email macro in userform

I have the following logic to send an email through outlook from excel. using a userform. The problem is having the textbox activated upon selecting the checkbox. The texbox does not activate upon checking it. I also have tried with the visible property.

The problem is the checkbox is not activating the logic that the else statement.

Private Sub CommandButton9_Click()
On Error GoTo ERRORMSG
Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object


Set otlApp = CreateObject("Outlook.Application")
Set olMail = otlApp.CreateItem(olMailItem)
Set Doc = olMail.GetInspector.WordEditor
Set mainWB = ActiveWorkbook

If CheckBox1.Value = False Then

mainWB.Sheets("Mail").Range("m8").Value = ComboBox4.Value
mainWB.Sheets("Mail").Range("n8").Value = TextBox40.Value
mainWB.Sheets("Mail").Range("q8").Value = ComboBox5.Value
mainWB.Sheets("Mail").Range("r8").Value = ComboBox6.Value
mainWB.Sheets("Mail").Range("s8").Value = ComboBox7.Value
mainWB.Sheets("Mail").Range("t8").Value = TextBox44.Value


 On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
    On Error GoTo 0

Set OutMail = OutApp.CreateItem(0)

With OutMail
    .To = "mainWB.Sheets("Mail").Range("G12").Value"
    .cc = mainWB.Sheets("Mail").Range("L12").Value
    .Subject = mainWB.Sheets("Mail").Range("O15").Value
    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor
    Set oRng = wdDoc.Range

    'force html format
    .HTMLBody = "<HTML><body><body></HTML>"
    .display


    '--- start with 6 CrLf's, so we can place each table
    '    above all but the last used...
    oRng.InsertAfter vbCrLf & vbCrLf

    '--- now reselect the entire document, collapse our cursor to the end
    '    and back up one character (so that the table inserts before the SIXTH CrLf)
    Set oRng = wdDoc.Range
    oRng.collapse 0
    oRng.Move 1, -1
    Range("K3:T10").Select
    Selection.Copy
    oRng.Paste


    '--- finally move the cursor all the way to the end and paste the
    '    second table BELOW the SIXTH CrLf
    Set oRng = wdDoc.Range
    oRng.collapse 0
    Range("K38:T46").Select
    Selection.Copy
    oRng.Paste
End With

Else
Label54.enable = True
TextBox46.enable = True

mainWB.Sheets("Mail").Range("m57").Value = ComboBox4.Value
mainWB.Sheets("Mail").Range("n57").Value = TextBox40.Value
mainWB.Sheets("Mail").Range("O57").Value = TextBox46.Value
mainWB.Sheets("Mail").Range("q57").Value = ComboBox5.Value
mainWB.Sheets("Mail").Range("r57").Value = ComboBox6.Value
mainWB.Sheets("Mail").Range("s57").Value = ComboBox7.Value
mainWB.Sheets("Mail").Range("t57").Value = TextBox44.Value


 On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
    On Error GoTo 0

Set OutMail = OutApp.CreateItem(0)

With OutMail
    .To = "mainWB.Sheets("Mail").Range("G12").Value"
    .cc = mainWB.Sheets("Mail").Range("L12").Value
    .Subject = mainWB.Sheets("Mail").Range("O15").Value
    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor
    Set oRng = wdDoc.Range

    'force html format
    .HTMLBody = "<HTML><body><body></HTML>"
    .display


    '--- start with 6 CrLf's, so we can place each table
    '    above all but the last used...
    oRng.InsertAfter vbCrLf & vbCrLf

    '--- now reselect the entire document, collapse our cursor to the end
    '    and back up one character (so that the table inserts before the SIXTH CrLf)
    Set oRng = wdDoc.Range
    oRng.collapse 0
    oRng.Move 1, -1
    Range("K52:T59").Select
    Selection.Copy
    oRng.Paste


    '--- finally move the cursor all the way to the end and paste the
    '    second table BELOW the SIXTH CrLf
    Set oRng = wdDoc.Range
    oRng.collapse 0
    Range("K38:T46").Select
    Selection.Copy
    oRng.Paste
End With
End If
Exit Sub
ERRORMSG:
MsgBox "No email was sent", vbExclamation
End Sub

you must:

  • set both Label54 and TextBox46 Enabled property prior to executing any Userform event handling code

    this you can achieve:

    • either with a Private Sub UserForm_Initialize() sub:

       Private Sub UserForm_Initialize() With Me .Label54.Enabled = False .TextBox46.Enabled = False End With End Sub
    • or in the Userform calling block of your "main" sub

      Sub Main() ... code With MyUserForm '<--| change "MyUserForm" to your actual userform name .Label54.Enabled = False .TextBox46.Enabled = False ... other possible code here to set some Userform members before showing it .Show '<--| show your userform End With Unload MyUserForm ... more code End SUb
  • set both Label54 and TextBox46 Enabled property in your CommandButton9_Click event handler accordingly to CheckBox1 value

    like follows:

     Option Explicit Private Sub CommandButton9_Click() Dim OutApp As Object Dim mailSht As Worksheet Dim rowOffset As Long Set OutApp = GetApp("Outlook.Application") If OutApp Is Nothing Then MsgBox "Couldn't set 'Outlook.Application' object" Exit Sub End If Set mailSht = ActiveWorkbook.Sheets("Mail") rowOffset = IIf(CheckBox1, 56, 7) '<--| set a row offset (from row 1) in according to CheckBox value Label54.Enabled = CheckBox1 '<--| enable Label54 control if CheckBox1 is checked TextBox46.Enabled = CheckBox1 '<--| enable TextBox46 control if CheckBox1 is checked With Me '<--| refer to this userform 'fill "Mail" sheet properly offsetted cells with ComboBoxes and TextBoxes values FillRangeWithComboBoxValue .ComboBox4, mailSht.Range("m1").Offset(rowOffset) mailSht.Range("n1").Offset(rowOffset).value = .TextBox40.value FillRangeWithComboBoxValue .ComboBox5, mailSht.Range("q1").Offset(rowOffset) FillRangeWithComboBoxValue .ComboBox6, mailSht.Range("r1").Offset(rowOffset) FillRangeWithComboBoxValue .ComboBox7, mailSht.Range("s1").Offset(rowOffset) mailSht.Range("t1").Offset(rowOffset).value = .TextBox44.value End With On Error GoTo ERRORMSG With OutApp.CreateItem(0) .To = mailSht.Range("G12").value .CC = mailSht.Range("L12").value .Subject = mailSht.Range("O15").value 'force html format .HTMLBody = "<HTML><body><body></HTML>" .display With .GetInspector.WordEditor '--- start with 6 CrLf's, so we can place each table ' above all but the last used... .Range.InsertAfter vbCrLf & vbCrLf '--- now reselect the entire document, collapse our cursor to the end ' and back up one character (so that the table inserts before the SIXTH CrLf) With .Range .collapse 0 .Move 1, -1 mailSht.Range("K3:T10").Copy .Paste End With '--- finally move the cursor all the way to the end and paste the ' second table BELOW the SIXTH CrLf With .Range .collapse 0 mailSht.Range("K38:T46").Copy .Paste End With End With End With Set OutApp = Nothing '<--| dispose the object variable Exit Sub ERRORMSG: MsgBox "Error on email processing", vbExclamation End Sub Function GetApp(appName As String) As Object On Error Resume Next Set GetApp = GetObject(, appName) If GetApp Is Nothing Then Set GetApp = CreateObject(appName) End Function Sub FillRangeWithComboBoxValue(cb As msforms.ComboBox, rng As Range) If cb.ListIndex <> -1 Then rng.value = cb.value End Sub

    where you see I proposed some code shortening and modulizing tips to have it (hopefully) more readable and maintainable

Thanks Guys, it was a simple fix. I put the checkbox condition in the checkbox change event and it works like a gem.

Private Sub CheckBox1_Change()

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM