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