Adding Input field from VBA form in an email

S

Stephan Leduc

Hello,

I tried to send some data from a userform I'd created and my code does
transmit the data into my worksheet but not in the email.

Anybody can help me out ?

Thanks

Here is my code:

Private Sub CommandButton1_Click()
'Clear the controls
'Clear the CONTACTNAME
ContactName.Value = ""
'Clear the PHONENUMBER
PhoneNumber.Value = ""
'Clear the ACCOUNTID
AccountID.Value = ""
'Clear the POSTINGID
PostingID.Value = ""
'Clear the FAR
FAR.Value = ""
'Clear the MESSAGE
Message.Value = ""
'Clear the REPNEEDED
RepNeeded.Value = ""
'Clear the FORWARDTO
ForwardTo.Value = ""
'Bring the cursor to the beginning of the form
VoiceMailSource.SetFocus

End Sub

Private Sub FAR_DropButtonClick()
FAR.RowSource = "FAR!B2:B26"
End Sub

Private Sub ForwardTo_DropButtonClick()
ForwardTo.RowSource = "ForwardTo!C2:C11"
End Sub

Private Sub Message_Change()

End Sub

Private Sub UserForm_Click()

End Sub

Private Sub VoiceMailSource_DropButtonClick()
VoiceMailSource.RowSource = "VoiceMailSource!B2:B6"
End Sub
Private Sub RepNeeded_DropButtonClick()
RepNeeded.RowSource = "RepNeeded!C2:C15"
End Sub
Private Sub CommandButton2_Click()
Dim NextRow As Long
'Make sure VoiceMailData is active
Sheets("VoiceMailData").Activate

'Determine the next empty row
NextRow = Application.WorksheetFunction. _
CountA(Range("A:A")) + 1

'Transfer the ID
Cells(NextRow, 1) = AutoNumber()
'Transfer the USER
Cells(NextRow, 2) = USER()
'Transfer the DATE
Cells(NextRow, 3).Value = Now()
'Transfer the SOURCE
Cells(NextRow, 4).Value = VoiceMailSource.Value
'Transfer the CONTACTNAME
Cells(NextRow, 5).Value = ContactName.Value
'Transfer the PHONENUMBER
Cells(NextRow, 6).Value = PhoneNumber.Value
'Transfer the ACCOUNTID
Cells(NextRow, 7).Value = AccountID.Value
'Transfer the POSTINGID
Cells(NextRow, 8).Value = PostingID.Value
'Transfer the FAR
Cells(NextRow, 9).Value = FAR.Value
'Transfer the MESSAGE
Cells(NextRow, 10).Value = Message.Value
'Transfer the REPNEEDED
Cells(NextRow, 11).Value = RepNeeded.Value
'Transfer the FORWARDTO
Cells(NextRow, 11).Value = ForwardTo.Value

'Clear the controls for the next entry
'Clear the CONTACTNAME
ContactName.Value = ""
'Clear the PHONENUMBER
PhoneNumber.Value = ""
'Clear the ACCOUNTID
AccountID.Value = ""
'Clear the POSTINGID
PostingID.Value = ""
'Clear the FAR
FAR.Value = ""
'Clear the MESSAGE
Message.Value = ""
'Clear the REPNEEDED
RepNeeded.Value = ""
'Clear the FORWARDTO
ForwardTo.Value = ""

'Bring the cursor to the beginning of the form
VoiceMailSource.SetFocus

'Message Box informing that the data has been posted
MsgBox "Your data has been posted. Thank You"
'Send the email
sendmail
End Sub


Public Function sendmail()
On Error GoTo ende

esubject = "URGENT - Voicemail from" & " " & ContactName.Value & " " &
AccountID.Value
sendto = "(e-mail address removed)"
ccto = "(e-mail address removed)"
ebody = "Please find the voicemail information left by" & " " &
ContactName.Value & vbCrLf & "on " & Now() & "." & vbCrLf & vbCrLf & vbCrLf &
vbCrLf & vbCrLf & "To=" & RepNeeded.Value & vbCrLf & "Account ID=" &
AccountID.Value & " " & " " & " " & " " & "Posting ID=" & PostingID.Value &
vbCrLf & "Reason for call=" & FAR.Value & vbCrLf & vbCrLf & "Message=" &
Message.Value & vbCrLf & vbCrLf & "ContactName=" & ContactName.Value & vbCrLf
& "Call Back #=" & PhoneNumber.Value & vbCrLf & vbCrLf & vbCrLf & "Thank You"
& vbCrLf & USER()

Set app = CreateObject("Outlook.Application")
Set itm = app.createitem(0)

With itm
..Subject = esubject
..to = sendto
..cc = ccto
..body = ebody
..display
Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "%S"

End With
Set app = Nothing
Set itm = Nothing
ende:
End Function
 
J

Joel

Try removing the error statment "On Error GoTo ende" and see where you error
is. You can also step through the code (Press F8 from VBA) to try to isolate
where the problem is.
 
S

Stephan Leduc

I can't figure it out.

Here is my updated code with your listbox suggestion in the other post.

Private Sub CanoeLogo_Click()

End Sub

Private Sub CommandButton1_Click()
'Clear the controls
'Clear the CONTACTNAME
ContactName.Value = ""
'Clear the PHONENUMBER
PhoneNumber.Value = ""
'Clear the ACCOUNTID
AccountID.Value = ""
'Clear the POSTINGID
PostingID.Value = ""
'Clear the FAR
FAR.Value = ""
'Clear the MESSAGE
Message.Value = ""
'Clear the REPNEEDED
RepNeeded.Value = ""
'Clear the FORWARDTO
ForwardTo.Value = ""
'Bring the cursor to the beginning of the form
VoiceMailSource.SetFocus

End Sub

Private Sub FAR_DropButtonClick()
FAR.RowSource = "FAR!B2:B26"
End Sub

Private Sub Message_Change()

End Sub



Private Sub PhoneNumber_Change()

End Sub


Private Sub Title_Click()

End Sub

Private Sub UserForm_Click()

End Sub

Private Sub VoiceMailSource_DropButtonClick()
VoiceMailSource.RowSource = "VoiceMailSource!B2:B6"
End Sub


Private Sub RepNeeded_Change()
off = RepNeeded.ListIndex
Email = Sheets("RepNeeded").Range("B2:B15").Offset(off, 1)
End Sub

Private Sub ForwardTo_Change()
off = ForwardTo.ListIndex
Cerberus = Sheets("ForwardTo").Range("B2:B11").Offset(off, 1)
End Sub

Private Sub UserForm_Initialize()

RepNeeded.Clear
RepNeeded.RowSource = "RepNeeded!B2:B15"
ForwardTo.Clear
ForwardTo.RowSource = "ForwardTo!B2:B11"

End Sub

Private Sub CommandButton2_Click()
Dim NextRow As Long
'Make sure VoiceMailData is active
Sheets("VoiceMailData").Activate

'Determine the next empty row
NextRow = Application.WorksheetFunction. _
CountA(Range("A:A")) + 1

'Transfer the ID
Cells(NextRow, 1) = AutoNumber()
'Transfer the USER
Cells(NextRow, 2) = USER()
'Transfer the DATE
Cells(NextRow, 3).Value = Now()
'Transfer the SOURCE
Cells(NextRow, 4).Value = VoiceMailSource.Value
'Transfer the CONTACTNAME
Cells(NextRow, 5).Value = ContactName.Value
'Transfer the PHONENUMBER
Cells(NextRow, 6).Value = PhoneNumber.Value
'Transfer the ACCOUNTID
Cells(NextRow, 7).Value = AccountID.Value
'Transfer the POSTINGID
Cells(NextRow, 8).Value = PostingID.Value
'Transfer the FAR
Cells(NextRow, 9).Value = FAR.Value
'Transfer the MESSAGE
Cells(NextRow, 10).Value = Message.Value
'Transfer the REPNEEDED
Cells(NextRow, 11).Value = RepNeeded.Value
'Transfer the FORWARDTO
Cells(NextRow, 11).Value = ForwardTo.Value

'Clear the controls for the next entry
'Clear the CONTACTNAME
ContactName.Value = ""
'Clear the PHONENUMBER
PhoneNumber.Value = ""
'Clear the ACCOUNTID
AccountID.Value = ""
'Clear the POSTINGID
PostingID.Value = ""
'Clear the FAR
FAR.Value = ""
'Clear the MESSAGE
Message.Value = ""
'Clear the REPNEEDED
RepNeeded.Value = ""
'Clear the FORWARDTO
ForwardTo.Value = ""

'Bring the cursor to the beginning of the form
VoiceMailSource.SetFocus

'Message Box informing that the data has been posted
MsgBox "Your data has been posted. Thank You"
'Send the email
sendmail
End Sub


Public Function sendmail()

esubject = "URGENT - Voicemail from" & " " & ContactName.Value & " " &
AccountID.Value
sendto = Email
ccto = "(e-mail address removed)"
ebody = "Please find the voicemail information left by" & " " &
ContactName.Value & vbCrLf & "on " & Now() & "." & vbCrLf & vbCrLf & vbCrLf &
vbCrLf & vbCrLf & "To=" & RepNeeded.Value & vbCrLf & "Account ID=" &
AccountID.Value & " " & " " & " " & " " & "Posting ID=" & PostingID.Value &
vbCrLf & "Reason for call=" & FAR.Value & vbCrLf & vbCrLf & "Message=" &
Message.Value & vbCrLf & vbCrLf & "ContactName=" & ContactName.Value & vbCrLf
& "Call Back #=" & PhoneNumber.Value & vbCrLf & vbCrLf & vbCrLf & "Thank You"
& vbCrLf & USER()

Set app = CreateObject("Outlook.Application")
Set itm = app.createitem(0)

With itm
..Subject = esubject
..to = sendto
..cc = ccto
..body = ebody
..display
Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "%S"

End With
Set app = Nothing
Set itm = Nothing
ende:
End Function
 
J

Joel

I tried to test all you code but there were too many objects to create and
some functions I didn't have. did the best to try to find the problem. The
only obvious problem were in these two functions below. The Range needed to
be only the first location not the entire range. OFF is the index number of
the item that is selected in the listbox. So you need to move down the
table(s) by the index number and move over one column

OFFSET(off,1) is really OFFSET(rowoffset:=off,columnoffset:=1)


Private Sub RepNeeded_Change()
off = RepNeeded.ListIndex
Email = Sheets("RepNeeded").Range("B2").Offset(off, 1)
End Sub

Private Sub ForwardTo_Change()
off = ForwardTo.ListIndex
Cerberus = Sheets("ForwardTo").Range("B2").Offset(off, 1)
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Date posting issue from Form 1
User Form 4
Write record from Form to new row in spreadsheet 1
Vlookup FALSE Value in VBA 2
Trying to run excel vba code when cell value changes from empty to entered value. 1
Copying or deleting row based on value found in other ws 7
Send data from Excel in email from specific email address 5
HELP!!! Beginner needs help with VBA coding 1

Top