Excel sending email format

[stevieccs]

This is going to be a series of questions relating to different topics I'm looking to achieve.
First issue: Looking to use a Static outlook account.

I currently use a search option code for the email account to send from.

Private Sub ACCOUNT_Click()

Dim OutApp As Outlook.Application
Dim I As Long

    Set OutApp = CreateObject("Outlook.Application")

    For I = 1 To OutApp.Session.Accounts.Count
        MsgBox OutApp.Session.Accounts.Item(I) & " : This is account number " & I
    Next I
End Sub

Next step is to input the account, to use when sending the email. i have a txt box on the user form that i input the value resulted.

.SendUsingAccount = OutApp.Session.Accounts.Item(txt_value.value)

I will also include the entire code, that i'm using I know its not complete/working/ or accurate to preform the functions. I'm just trying to make my job easier and more faster and less error prone to missing something when sending an email.

Private Sub ACCOUNT_Click()
'Don 't forget to set a reference to Outlook in the VBA editor
    Dim OutApp As Outlook.Application
    Dim I As Long

    Set OutApp = CreateObject("Outlook.Application")

    For I = 1 To OutApp.Session.Accounts.Count
        MsgBox OutApp.Session.Accounts.Item(I) & " : This is account number " & I
    Next I
End Sub

Private Sub BUTTON_SEND_Click()
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
  
    strbody = "ID - " & TXT_BLOCK.Value & vbNewLine & _
              "DEAR " & RANK_ComboBox.Value & " " & TXT_FNAME.Value & " " & TXT_LNAME.Value & "," & vbNewLine & _
              vbNewLine & _
              "    Your travel voucher you've submitted is currently in review with our Electronic Funds Transfer team. It has been determined for the reasons below that additional information is needed to finalize your payment. Currently your travel voucher is placed on hold for 5 business days from the date we sent this email. Your Travel Claim will be released as soon as we receive and process the SF-1199A. All travel claims are processed on your Travel EFT account (this is different from your regular pay), the travel account must be validated every 3 years to ensure security and payment is sent to the correct account on file." & vbNewLine & _
              vbNewLine & _
              "Please note the reason(s) below for our contact:" & vbNewLine & _
              REASON_ListBox.Value
            
On Error Resume Next
    With OutMail
        .To = TXT_EMAIL.Value
        .Subject = "EFT UPDATE REQUEST"
        .Body = strbody
        .Importance = olImportanceHigh
        .ReadReceiptRequested = True
        .Attachments.Add Environ("userprofile") & "\Desktop\TREE\SF1199A.pdf", olByValue, 1, "SF1199A"
        .SendUsingAccount = OutApp.Session.Accounts.Item(txt_value.Value)
        
        '.Send
        .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Private Sub UserForm_Initialize()
On Error GoTo ErrorHandle

With RANK_ComboBox
   .AddItem "PV1"
   .AddItem "PV2"
   .AddItem "PFC"
   .AddItem "SPC"
   .AddItem "SSG"
   .AddItem "SFC"
   .AddItem "MSG"
   .AddItem "1SG"
   .AddItem "SGM"
   .AddItem "CSM"
   .AddItem "SMA"
   .AddItem "W01"
   .AddItem "W02"
   .AddItem "W03"
   .AddItem "W04"
   .AddItem "W05"
   .AddItem "2LT"
   .AddItem "1LT"
   .AddItem "CPT"
   .AddItem "MAJ"
   .AddItem "LTC"
   .AddItem "COL"
   .AddItem "BG"
   .AddItem "MG"
   .AddItem "LTG"
   .AddItem "GEN"
End With

With REASON_ListBox
    .AddItem "Your EFT information needs to be verified for your TRAVEL account. For security your account was created +3 years ago."
    .AddItem "Your EFT information is hidden by a waiver on your account we cannot access you EFT information."
    .AddItem "All EFT accounts are in deleted status due to ETS or RET."
    .AddItem "There is no Travel account on file in our Corporate EFT Data base"

End With

Exit Sub
ErrorHandle:
If Err.Number = 0 Then
        End If
If Err.Number = 94 Then
    MsgBox "Select the rank or type in rank"
        End If
'MsgBox Err.Description

End Sub

I'm at the very beginning of development of this code and it has just been a pain in the ass,
Also the list box is not working when a selection is made, also i need multiples for support
If anyone would be able to help me with this problem it would be wonderful.

[Kenneth Hobs]

I guess you would want to make sure that TXT_value = one of your session values. You can check that using an On Error with a line that would cause an error. You would have to iterate all of the i's in your first block of code and then compare each to your Txt_Value.

I guess the rest of the email part works except for the ListBox?

Here is one way to get the selected items. The Join() part is what you will concatenate in your Body string.

Private Sub CommandButton2_Click()  'OK button  Dim a
  a = LbCb1ToArray(REASON_Listbox)
  If Not IsArray(a) Then Exit Sub
  MsgBox Join(a, vbCrLf)
End Sub


'Listbox column 1 or combobox column 1 to array.
Private Function LbCb1ToArray(LbCb As Control)
  Dim i As Long, j As Long, a
  
  With LbCb
    ReDim a(1 To .ListCount)
    For i = 0 To .ListCount - 1
      If .Selected(i) = True Then
        j = j + 1
        a(j) = .List(i, 0)
      End If
    Next i
  End With
  
  If j > 0 Then
    ReDim Preserve a(1 To j)
    LbCb1ToArray = a
  End If
End Function