I am trying to send an email based on a combobox selection and a click of a submit button. I get a type mismatch error. I used select case because I will be adding more than one combobox with names to the form.
Dim StrEmail as String
Select Case Me.cmbOwner2
Case Is = "AV"
If StrEmail Is Null Then
StrEmail = "dan.moses#yahoo.com"
Else
StrEmail = StrEmail & "," & "dan.moses#yahoo.com"
Case Is = "ENG"
If StrEmail Is Null Then
StrEmail = "brianna.cates#yahoo.com"
Else
StrEmail = StrEmail & "," & "brianna.cates#yahoo.com"
End If
End Select
DoCmd.SendObject acSendForm, "frmETIC", acFormatPDF, "StrEmail", "", _
"", "Recovery Report", "Attached is the submitted Recovery Report"
DoCmd.Close acForm, "frmETIC", acSaveNo
DoCmd.OpenForm "frmETIC", acNormal, , , acFormEdit, acWindowNormal
A couple of things:
1) Avoid using if strEmail = null, or ifnull(strEmail).
Instead, do either if strEmail="", or if len(strEmail)=0
Reason: when you declare a String variable in VBA, testing it for null will return false. So in your code, it is jumping directly to this part:
Else
StrEmail = StrEmail & "," & "dan.moses#yahoo.com"
which means your string of recipients starts with a comma.
2) Use a semicolon instead of a comma as the separator for recipients in Outlook.
Related
I have a code that I was able to string together that logs my sent emails into an excel sheet so i can use that data for other analysis.
In it, I have it resolving the name into an email as outlook shortens it ("Jimenez, Ramon" = email#address.com) as outlook configured this and it works when i send an email to anyone in my company as they are in my address book.
Now, when I email anyone outside it defaults to lastName, firstName so it is not converting this and logging it.
I thought the code I have in here already does this, but I guess not. I have already come this far and I am NOT a software guru at all. Does anyone have insight on how I can also include this as well?? Please see code below:
Private WithEvents Items As Outlook.Items
Const strFile As String = "C:\Users\a0227084\Videos\work\test.xlsx"
Private Sub Application_Startup()
Dim OLApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set OLApp = Outlook.Application
Set objNS = OLApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderSentMail).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
FullName = Split(Msg.To, ";")
For i = 0 To UBound(FullName)
If i = 0 Then
STRNAME = ResolveDisplayNameToSMTP(FullName(i))
Call Write_to_excel(CStr(Msg.ReceivedTime), CStr(Msg.Subject), CStr(STRNAME))
ElseIf ResolveDisplayNameToSMTP(FullName(i)) <> "" Then
STRNAME = ResolveDisplayNameToSMTP(FullName(i))
Call Write_to_excel(CStr(Msg.ReceivedTime), CStr(Msg.Subject), CStr(STRNAME))
End If
Next i
'Call Write_to_excel(CStr(Msg.ReceivedTime), CStr(Msg.Subject), CStr(STRNAME))
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Sub tes2t()
End Sub
Function getRecepientEmailAddress(eml As Variant)
Set out = CreateObject("System.Collections.Arraylist") ' a JavaScript-y array
For Each emlAddr In eml.Recipients
If Left(emlAddr.Address, 1) = "/" Then
' it's an Exchange email address... resolve it to an SMTP email address
out.Add ResolveDisplayNameToSMTP(emlAddr)
Else
out.Add emlAddr.Address
End If
Next
getRecepientEmailAddres = Join(out.ToArray(), ";")
End Function
Function ResolveDisplayNameToSMTP(sFromName) As String
' takes a Display Name (i.e. "James Smith") and turns it into an email address (james.smith#myco.com)
' necessary because the Outlook address is a long, convoluted string when the email is going to someone in the organization.
' source: https://stackoverflow.com/questions/31161726/creating-a-check-names-button-in-excel
Dim OLApp As Object 'Outlook.Application
Dim oRecip As Object 'Outlook.Recipient
Dim oEU As Object 'Outlook.ExchangeUser
Dim oEDL As Object 'Outlook.ExchangeDistributionList
Set OLApp = CreateObject("Outlook.Application")
Set oRecip = OLApp.Session.CreateRecipient(sFromName)
oRecip.Resolve
If oRecip.Resolved Then
Select Case oRecip.AddressEntry.AddressEntryUserType
Case 0, 5 'olExchangeUserAddressEntry & olExchangeRemoteUserAddressEntry
Set oEU = oRecip.AddressEntry.GetExchangeUser
If Not (oEU Is Nothing) Then
ResolveDisplayNameToSMTP = oEU.PrimarySmtpAddress
End If
Case 10, 30 'olOutlookContactAddressEntry & 'olSmtpAddressEntry
Dim PR_SMTP_ADDRESS As String
PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
ResolveDisplayNameToSMTP = oRecip.AddressEntry.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
End Select
End If
End Function
Sub Write_to_excel(str1 As String, str2 As String, str3 As String)
Dim xlApp As Object
Dim sourceWB As Workbook
Dim sourceWH As Worksheet
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.EnableEvents = False
End With
Set sourceWB = Workbooks.Open(strFile, False, False)
Set sourceWH = sourceWB.Worksheets("Sheet1")
sourceWB.Activate
With sourceWH
lastrow = .Cells(.rows.Count, "A").End(xlUp).Row
End With
sourceWH.Cells(lastrow + 1, 1) = str1
sourceWH.Cells(lastrow + 1, 2) = str2
sourceWH.Cells(lastrow + 1, 3) = str3
sourceWB.Save
sourceWB.Close
End Sub
Error message and corrected code
Regards,
Ramon
First of all, there is no need to create a new Application instance in the ResolveDisplayNameToSMTP method:
Set OLApp = CreateObject("Outlook.Application")
Instead, you can use the Application property available in the Outlook VBA editor out of the box.
Second, you need to use the following code to get the SMTP address from the AddressEntry object:
Dim PR_SMTP_ADDRESS As String
Set PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
ResolveDisplayNameToSMTP = oRecip.AddressEntry.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
Instead of the following line:
ResolveDisplayNameToSMTP = oRecip.AddressEntry.Address
Read more about that in the How to get the SMTP Address of the Sender of a Mail Item using Outlook Object Model? article.
Thanks in advance :), I am trying to attach the data of subform also in mail body.
Current Status: I am able to attach Main forms data and generate mail but unable to attach subform's data as it only includes the first row, Tryied doing it through Subform and query both but no success. I will prefer to do it by subform itself. Subform's Name is : "subUpdateOrder". VB Code:
Private Sub InformCustomer_Click()
On Error GoTo Err_InformCustomer_Click
Dim CustName As String ' Customer Name
Dim varTo As Variant '-- Address for SendObject
Dim stText As String '-- E-mail text
Dim DelDate As Variant '-- Rec date for e-mail text
Dim stSubject As String '-- Subject line of e-mail
Dim stOrderID As String '-- The Order ID from form
Dim detailQry As String
'Dim stHelpDesk As String '-- Person who assigned ticket
'Dim strSQL As String '-- Create SQL update statement
'Dim errLoop As Error
CstName = Me![CustName]
varTo = Me![CustEmail]
stSubject = ":: Update - Oder Status ::"
stOrderID = Me.[OdrID]
DelDate = Me.[OdrDeliveryDate]
stText = "Dear" & CstName & _
"You have been assigned a new ticket." & Chr$(13) & Chr$(13) & _
"Order Number: " & stOrderID & Chr$(13) & _
"Please refer to your order status " & Chr$(13) & _
"Exp Delevery Date: " & DelDate & Chr$(13) & Chr$(13) & _
dQuery & Chr$(13) & _
"This is an automated message. Please do not respond to this e-mail."
'Write the e-mail content for sending to assignee
DoCmd.SendObject , , acFormatTXT, varTo, , , stSubject, stText, True
Err_InformCustomer_Click:
MsgBox Err.Description
End Sub
Form Img: Form and Command1 button to run the code
It would be something like (to insert before CstName = Me![CustName]):
Dim dQuery As String
Dim rs As DAO.Recordset
Set rs = Me!NameOfYourSubformCONTROL.Form.RecordsetClone
While Not rs.EOF
dQuery = dQuery & rs![Brand Name].Value & vbTab & rs![Model Name].Value & vbTab & rs![Color].Value & vbCrLF
Wend
Set rs = Nothing
I am writing an VB6 application in which I'm making use of cdosys.dll in order to send mails. I am able to attach and send the mails but the problem that I'm facing is the attached file icon image is not getting displayed correctly (default icon image is getting displayed). Also I am not able to attach the files between two paragraphs in the body part. I am using IBM Lotus Notes mail system. Please find below the code that I'm using and also the screenshot of issue that I'm facing
Set objEmail = CreateObject("CDO.Message")
objEmail.MimeFormatted = True
objEmail.To = to address
objEmail.From = from address
objEmail.Subject = "Additional Replacement Letters : " & Format(Now, "mm/dd")
objEmail.TextBody = "Hello Team," & vbCrLf & vbCrLf & "find below the attached letters"
Set fld = FSO.GetFolder(path)
For Each fil In fld.Files
Set iBp = objEmail.AddAttachment(fil)
Next
objEmail.TextBody = "Revert to me for any concerns"
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.domain.com"
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
Please help me how to solve this issue.
First, for the icons of files appearing in the attachments section. If a generic file icon is displayed, it may be because either:
your system doesn't have any/the correct MIME type defined for *.doc files (shouldn't be the case if you have Word installed);
the client cannot match any extension (and thus an icon) to the MIME type included with an attached file; or
if the recipient is viewing the emails through a web-based email system, the provider might not have/provide an image to show as an icon for those types of files.
In most cases it's the client software that is too lazy to display the appropriate icon.
Now, if you want the files to appear amid the email body, this is another story. Here an overview of what needs to be done:
First, you don't add files through IMessage.AddAttachment() but with IMessage.AddRelatedBodyPart();
When called, IMessage.AddRelatedBodyPart() will return an IBodyPart object;
Using the IBodyPart object, you need to assign a unique content ID to the piece – you can use the file name, but whatever the CID it must not contain spaces;
You then need to write your email body in HTML (so you can link to them);
In the message you'll add links to related parts as such:
Link to the file
where %CONTENT_ID_OF_THE_FILE% is the content ID you set for the file. Example:
Link to the file
There are two things you'll have to remember if you insert files this way:
You won't see any icon aside or elsewhere related to the file(s) attached, i.e. they'll appear as you set them through your HTML code. If you want any, you'll have to add images (not icon files) the same way and refer to them using the <img> tag and their content ID.
In many clients, you won't see the files in the attachments section, unless they're not being referred to in the body (or their content ID doesn't match, which is the same thing)
Here is some code. It's pretty complete, as I had to test it because I wasn't sure to remember everything correctly. Also, it is assumed you have among the references for your project Microsoft CDO for Windows 2000 Library and Microsoft Scripting Runtime.
Public Function SendNewLetters(ByVal PathForLetters As String, ByVal FromName As String, ByVal FromEmail As String, ByVal ToName As String, _
ByVal ToEmail As String, ByVal SMTPServer As String, ByVal SMTPPort As Long, ByVal SMTPUser As String, _
ByVal SMTPPassword As String, Optional ByVal UseSSL As Boolean = False, Optional ByRef ErrorCode As Long = 0, _
Optional ErrorDesc As String = vbNullString) As Boolean
On Error GoTo ErrorHandler
Const CdoReferenceTypeName = 1
Dim iMsg As CDO.Message ' Not using CreateObject() because I have the reference added
Dim sFileCID As String, sFileExt As String
Dim sIconImageSrc As String, sIconImageCID As String
Dim iBpAttachment As CDO.IBodyPart ' Will be reused more than once
Dim iBpIconImage As CDO.IBodyPart
Dim oFSO As Scripting.FileSystemObject
Dim oFolder As Scripting.Folder
Dim oFile As Scripting.File
Dim oDictAddedExtIcons As Scripting.Dictionary
Set iMsg = New CDO.Message
' Configure SMTP parameters
With iMsg.Configuration
.Fields(cdoSMTPServer) = SMTPServer
.Fields(cdoSMTPServerPort) = SMTPPort
.Fields(cdoSMTPUseSSL) = UseSSL
.Fields(cdoSMTPAuthenticate) = cdoBasic
.Fields(cdoSendUserName) = SMTPUser
.Fields(cdoSendPassword) = SMTPPassword
.Fields(cdoSMTPConnectionTimeout) = 60
.Fields(cdoSendUsingMethod) = cdoSendUsingPort
.Fields.Update
End With
' Set From and To fields
If Len(FromName) > 0 Then
' Let's say we already QP-encoded any special chars for the name
' and checked the email address
iMsg.From = FromName & " <" & FromEmail & ">"
Else
iMsg.From = FromEmail
End If
If Len(ToName) > 0 Then
' Same thing here
iMsg.To = ToName & " <" & ToEmail & ">"
Else
iMsg.To = ToEmail
End If
' Set subject (would need QP encoding as well)
iMsg.Subject = "Additional Replacement Letters : " & Format(Now, "mm/dd")
' Build the body
iMsg.HTMLBody = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional //EN""><html><body><p>Hello Team,<br/><br/>" & _
"Please find below the attached letters</p><div style=""display: table"">"
' Will be used to make sure icon images are only added once
Set oDictAddedExtIcons = New Scripting.Dictionary
' Add files here, one new body part for each
Set oFSO = New Scripting.FileSystemObject
If oFSO.FolderExists(PathForLetters) Then
Set oFolder = oFSO.GetFolder(PathForLetters)
For Each oFile In oFolder.Files
' IMPORTANT: Content-IDs should not contain spaces
sFileCID = Replace$(oFile.Name, " ", "_")
Set iBpAttachment = iMsg.AddRelatedBodyPart(oFile.Path, oFile.Name, CdoReferenceTypeName)
iBpAttachment.Fields.Item("urn:schemas:mailheader:content-id") = "<" & sFileCID & ">"
iBpAttachment.Fields.Update ' Dont' forget that line
sFileExt = LCase$(GetFileExtension(oFile.Name))
sIconImageSrc = vbNullString
Select Case sFileExt
Case "doc"
' We provide here the path to a 32x32 image of the doc file icon
sIconImageSrc = "C:\Users\MyUserName\Desktop\DocIcon.png"
' We could also provide images for other extensions, or
' (more involved) query the DefaultIcon for any extension from
' the registry, load the icon from the ico/exe/dll file and
' find the best size/resize if necessary (already have the
' code, but it's a *lot* of code).
Case ".."
' Add support for more
End Select
If Len(sIconImageSrc) > 0 Then
If Not oDictAddedExtIcons.Exists(sFileExt) Then
sIconImageCID = GetFilePart(sIconImageSrc) ' Is the filename for this and the next line
Set iBpIconImage = iMsg.AddRelatedBodyPart(sIconImageSrc, sIconImageCID, CdoReferenceTypeName)
' IMPORTANT: Content-IDs should not contain spaces
sIconImageCID = Replace$(sIconImageCID, " ", "_")
iBpIconImage.Fields.Item("urn:schemas:mailheader:content-id") = "<" & sIconImageCID & ">"
iBpIconImage.Fields.Update ' Dont' forget that line
oDictAddedExtIcons.Add sFileExt, sIconImageCID
sIconImageSrc = "cid:" & sIconImageCID
Else
sIconImageSrc = "cid:" & oDictAddedExtIcons.Item(sFileExt)
End If
End If
iMsg.HTMLBody = iMsg.HTMLBody & "<div style=""display: table-row""><div style=""text-align: left; " & _
"vertical-align: middle; margin-right: 10px;"">"
If Len(sIconImageSrc) > 0 Then
iMsg.HTMLBody = iMsg.HTMLBody & "<img src=""" & sIconImageSrc & """ border=""0"" />"
Else
iMsg.HTMLBody = iMsg.HTMLBody & " "
End If
iMsg.HTMLBody = iMsg.HTMLBody & "</div><div style=""display: table-cell; text-align: left; vertical-align: middle;"">"
iMsg.HTMLBody = iMsg.HTMLBody & "" & oFile.Name & ""
iMsg.HTMLBody = iMsg.HTMLBody & "</div></div>"
Next
End If
iMsg.HTMLBody = iMsg.HTMLBody & "</div><br/>"
iMsg.HTMLBody = iMsg.HTMLBody & "<p>Revert to me for any concerns.</p></body></html>"
' Send away!
iMsg.Send
SendNewLetters = True
Exit Function
ErrorHandler:
ErrorCode = Err.Number
ErrorDesc = Err.Description
SendNewLetters = False
End Function
Public Function GetFilePart(ByVal FilePath As String) As String
Dim lPos As Long
lPos = InStrRev(FilePath, "\")
If lPos > 0 Then
GetFilePart = Right$(FilePath, Len(FilePath) - lPos)
End If
End Function
Public Function GetFileExtension(ByVal FilePath As String, Optional ByVal WithDot As Boolean = False) As String
Dim lPos As Long
lPos = InStrRev(FilePath, ".")
If InStr(1, FilePath, ".") Then
If WithDot Then
GetFileExtension = Right$(FilePath, Len(FilePath) - lPos + 1)
Else
GetFileExtension = Right$(FilePath, Len(FilePath) - lPos)
End If
End If
End Function
Here is the image I used for the *.doc icon:
And this is what it would look like when sent:
I hope it works for you!
I use the following code to get ContactInfo (in Outlook2010) of each recipient of a mail to be sent. The code works, but only for a few contacts, although all contacts are stored in my adressbook. For some the last line (GetContact) delivers Nothing. Why?
' Create RDO session
Dim session
Set session = CreateObject("Redemption.RDOSession")
Set session.MAPIOBJECT = Application.session.MAPIOBJECT
' Get current email
ActiveInspector.CurrentItem.Save ' Necessary to get current status
Dim mail
Set mail = session.GetMessageFromID(ActiveInspector.CurrentItem.EntryID)
' Create salutation line
Dim salutationLine As String
salutationLine = ""
For Each Recipient In mail.Recipients
' Skip CC and BCC addresses
If (Recipient.Type <> olTo) Then GoTo NextRecipient
' Assume standard salutation and use complete name as first name
Dim salutationType As String
salutationType = ""
Dim firstName As String
Dim lastName As String
Dim recipientName As String
recipientName = IIf(Recipient.Name <> "", Recipient.Name, Recipient.Address)
lastName = ""
If InStr(1, recipientName, " ") > 0 Then
firstName = Split(recipientName, " ")(0)
lastName = Split(recipientName, " ")(1)
End If
Dim addressEntry
Set addressEntry = Recipient.addressEntry
If (Not addressEntry Is Nothing) Then
' If we have qualified name information: extract first and last name
If (addressEntry.firstName <> "") Then firstName = addressEntry.firstName
If (addressEntry.lastName <> "") Then lastName = addressEntry.lastName
Dim contactInfo
Set contactInfo = addressEntry.GetContact()
If (Not contactInfo Is Nothing) Then
GetContact in both Outlook Object Model and Redemption relies on the entry id being of OAB type. On the incoming messages, all SMTP recipients have one-off entry id (it does not point to any existing address book objects and embeds name, address and address type inside).
In general, you will need to extract the recipient address, then search the Contacts folder for a matching contact based on email1, email2 or email3 values.
No idea why this isn't working.
I have a simple form with some text boxes and drop down lists. It displays the profile of an employee. Users should be able to manually edit the fields and click Save. When they click save I keep getting errors.
Q1: How can I handle inserting Null values for SmallDateTime data types?
Q2: What am I doing wrong with the TinyInt (SqlServer 2005) on the JobGrade?
Option Explicit On
Imports System
Imports System.Data
Imports System.Data.SqlClient
Protected Sub btnSave_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSave.Click
Dim sqlJobsDB As New SqlConnection(ConfigurationManager.ConnectionStrings("JobsDB").ConnectionString)
Dim sqlCmdUpdate As SqlCommand = sqlJobsDB.CreateCommand()
Try
sqlJobsDB.Open()
sqlCmdUpdate.CommandText = _
"UPDATE tblEmployee " + _
"SET Firstname = #Firstname, LastName = #LastName, HiredLastName = #HiredLastName, " + _
"DateHired = #DateHired, Role = #Role, CADate = #CADate, CAType = #CAType, " + _
"JobDate = #JobDate, JobGrade = #JobGrade " + _
"WHERE EUID = '" & Session("sProfileEUID") & "';"
sqlCmdUpdate.Parameters.Add("#FirstName", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#LastName", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#HiredLastName", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#DateHired", SqlDbType.SmallDateTime)
sqlCmdUpdate.Parameters.Add("#Role", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#CADate", SqlDbType.SmallDateTime)
sqlCmdUpdate.Parameters.Add("#CAType", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#JobDate", SqlDbType.SmallDateTime)
sqlCmdUpdate.Parameters.Add("#JobGrade", SqlDbType.TinyInt)
sqlCmdUpdate.Parameters("#FirstName").Value = txtFirstName.Text
sqlCmdUpdate.Parameters("#LastName").Value = txtLastName.Text
sqlCmdUpdate.Parameters("#HiredLastName").Value = txtHiredLastName.Text
sqlCmdUpdate.Parameters("#DateHired").Value = txtDateHired.Text
sqlCmdUpdate.Parameters("#Role").Value = ddlRole.SelectedValue.ToString
If txtCADate.Text = "" Then
sqlCmdUpdate.Parameters("#CADate").Value = 0
Else
sqlCmdUpdate.Parameters("#CADate").Value = txtCADate.Text
End If
sqlCmdUpdate.Parameters("#CAType").Value = ddlCAType.SelectedValue
If txtJobDate.Text = "" Then
sqlCmdUpdate.Parameters("#JobDate").Value = 0
Else
sqlCmdUpdate.Parameters("#JobDate").Value = txtJobDate.Text
End If
sqlCmdUpdate.Parameters("#JobGrade").Value = CByte(txtJobGrade.Text)
sqlCmdUpdate.ExecuteNonQuery()
Catch ex As Exception
'Debugging
lblErrMsg.Text = ex.ToString
lblErrMsg.Visible = True
Finally
sqlJobsDB.Close()
End Try
End Sub</code>
I open the form and fill it out correctly.
I'll enter something like "4" (no quotes) for JobGrade. It still says "conversion from strink ''" like its not even seeing when I input items on the form.
Errors are below:
System.InvalidCastException: Conversion from string "" to type 'Byte' is not valid. ---> System.FormatException: Input string was not in a correct format. at Microsoft.VisualBasic.CompilerServices.Conversions.ParseDouble(String Value, NumberFormatInfo NumberFormat) at Microsoft.VisualBasic.CompilerServices.Conversions.ToByte(String Value) --- End of inner exception stack trace --- at Microsoft.VisualBasic.CompilerServices.Conversions.ToByte(String Value) at Profile.btnSave_Click(Object sender, EventArgs e) in
Update
The DBNull.Value issue is resolved.
The JobGrade, and Role are still issues. When throwing up some breakpoints on it doens't fetch the contents of the textbox or the dropdown list.
** Updated Code **
Protected Sub btnCancel_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnCancel.Click
Session("sProfileEUID") = Nothing
Response.Redirect("~/Management/EditUsers.aspx")
End Sub
Protected Sub btnSave_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSave.Click
Dim sqlJobsDB As New SqlConnection(ConfigurationManager.ConnectionStrings("JobsDB").ConnectionString)
Dim sqlCmdUpdate As SqlCommand = sqlJobsDB.CreateCommand()
Try
sqlJobsDB.Open()
sqlCmdUpdate.CommandText = _
"UPDATE tblEmployee " + _
"SET FirstName = #FirstName, LastName = #LastName, HiredLastName = #HiredLastName, " + _
"DateHired = #DateHired, Role = #Role, CADate = #CADate, CAType = #CAType, " + _
"JobDate = #JobDate, JobGrade = #JobGrade " + _
"WHERE EUID = '" & Session("sProfileEUID") & "';"
sqlCmdUpdate.Parameters.Add("#FirstName", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#LastName", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#HiredLastName", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#DateHired", SqlDbType.SmallDateTime)
sqlCmdUpdate.Parameters.Add("#Role", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#CADate", SqlDbType.SmallDateTime)
sqlCmdUpdate.Parameters.Add("#CAType", SqlDbType.VarChar)
sqlCmdUpdate.Parameters.Add("#JobDate", SqlDbType.SmallDateTime)
sqlCmdUpdate.Parameters.Add("#JobGrade", SqlDbType.TinyInt)
sqlCmdUpdate.Parameters("#FirstName").Value = txtFirstName.Text
sqlCmdUpdate.Parameters("#LastName").Value = txtLastName.Text
sqlCmdUpdate.Parameters("#HiredLastName").Value = txtHiredLastName.Text
sqlCmdUpdate.Parameters("#DateHired").Value = txtDateHired.Text
sqlCmdUpdate.Parameters("#Role").Value = ddlRole.SelectedValue.ToString
If txtCADate.Text <> "" Then sqlCmdUpdate.Parameters("#CADate").Value = CDate(txtCADate.Text)
If txtCADate.Text = "" Then sqlCmdUpdate.Parameters("#CADate").Value = DBNull.Value
If ddlCAType.Text <> "" Then sqlCmdUpdate.Parameters("#CAType").Value = ddlCAType.SelectedValue
If ddlCAType.Text = "" Then sqlCmdUpdate.Parameters("#CAType").Value = DBNull.Value
If txtJobDate.Text <> "" Then sqlCmdUpdate.Parameters("#JobDate").Value = CDate(txtJobDate.Text)
If txtJobDate.Text = "" Then sqlCmdUpdate.Parameters("#JobDate").Value = DBNull.Value
If txtJobGrade.Text <> "" Then sqlCmdUpdate.Parameters("#JobGrade").Value = CInt(txtJobGrade.Text)
If txtJobGrade.Text = "" Then sqlCmdUpdate.Parameters("#JobGrade").Value = DBNull.Value
sqlCmdUpdate.ExecuteNonQuery()
Catch ex As Exception
lblErrMsg.Text = ex.ToString
lblErrMsg.Visible = True
Finally
sqlJobsDB.Close()
End Try
End Sub
Edit 2:
So I've pretty much given up on this, and instead moved the table into an FormView ItemTemplate, with an EditTemplate also. I modified it as described in the following link. http://www.beansoftware.com/ASP.NET-Tutorials/FormView-Control.aspx
Q1: Make sure the table structure allows nulls and set the parameter value to DBNull.Value.
Q2:
If IsNumeric(txtJobGrade.Text) Then
sqlCmdUpdate.Parameters("#JobGrade").Value = CInt(txtJobGrade.Text)
Else
sqlCmdUpdate.Parameters("#JobGrade").Value = 0 'Or Default Value
End If
You can always make that a drop down list to prevent open ended data input.
It's a little odd to see how you're done the parameters. Typically, I'd expect to see something more along these lines:
With sqlCmdUpdate.Parameters
.clear()
.addWithValue("#parm1", mytextbox1.text)
.addWithValue("#parm2", mytextbox2.text)
End With
For one, .add has been deprecated -- still works, but some issues to be aware of (http://msdn.microsoft.com/en-us/library/system.data.sqlclient.sqlparametercollection.addwithvalue.aspx).
Secondly, it's always best to call .clear().
Also -- you might think about a more standard approach to checking for values -- for example:
If txtJobGrade.Text <> "" Then...
Would be better written as
If NOT string.isnullorempty(me.txtJobGrade.text) Then...
Try making a few of those changes, and see what (if any) errors you're still getting.