Assigning text to a number value Results

I am creating a report to print various information from a data table I have created. I need the report to show a text for the number value. For example, for gender the data is in the table as "1" or "2". I need the report to say "Male" for 1 and "Female" for 2. Is it possible to do this? Do I need to create a query? Thanks!

Hi,
Complete newbie question, I have various yes/no boxes that i want to give a numeric value. The i want to add up these numbers and report it back to a text box.

Any help you can offer would be greatly appreciated.

Thanks in advance
Martin

ACCOUNT 400001 400002 400003 400004 400005 400006 400008 400012 400013 400075 400076 400077 420001 420002 420003 420004 420005 420006 420008 420010 420012 420013 420075 420076 420077

Question 1: What is the function that converts text to a number? I am working with the above, which I want to leave in the original table as text, but I would like to set up a query that contains both the text version, and a formula that converts the text to a number format so I can build an expression (I am thinking I probably can't use greater than/less than on a text format number).

Question 2: I want to build an column called TYPE using an if statement that states if the ACCOUNT is > 400000 or < 400099, assign a value of "IP", and if the ACCOUNT is

Is there any way to determine the value type of an openargs value being passed, and then assign the value to the appropriate field depending on its value?

Example:
The onOpen even of my customer details from is now set to assign the openargs value (if any) to the Account Number field. What I want it to do is, if the openargs value is “numeric” (a 4 or 5 digit number only) then assign its value to account number field, but if it is a “text” value (customer name lets say) then assign its value to the Customer name field.

If that is even possible, I would need to go one step further and somehow distinguish the difference between a customer name value (text only) and the value of an address (mixed numbers and text) to pass the value to the correct field.

Was thinking something along the line of: (pretty sure these functions doesn't exist)

if openargs.datatype = "text only" then
me.customer_name = openargs
ElseIf openarge.datatype = "numeric value only" then
me.account_number = openargs
Elseif openargs.datatype = “numeric and text Value" then
me.Address = openargs
End If

Anyone have correct syntax for this or any other suggestions?

Hi Guys,

Thanks in advance for your help with this. I've modified some code online and am by no means a programmer, but dabbled in the attempt.

I am getting a parameter value error, which from my research means their is a unassigned null value. I have input some code for the only var lookup statement I believe will return a null value however am still getting an error.

Also, as I say, I'm new and there may well be some other errors. If some eagle eye would be kind enough to look at what I'm doing and give me some advice, for something that may crop up after having variable matter sorted it'd be hugely appreciated.

Private Sub cmdSendEmail_Click()
On Error GoTo Err_cmdSendEmail_Click

Dim stWhere As String '-- Criteria for DLookup
Dim varTo As Variant '-- Address for SendObject
Dim stText As String '-- E-mail text
Dim RecDate As Variant '-- Rec date for e-mail text
Dim stSubject As String '-- Subject line of e-mail
Dim stEmailID As String '-- The ticket ID from form
Dim stWho As String '-- Reference to tblUsers
Dim EmployeeID As String '-- Person who assigned ticket
Dim strSQL As String '-- Create SQL update statement
Dim errLoop As Error


'-- Combo of names to assign ticket to
stWho = Me.cmdEmailTo
stWhere = "tblContacts.ContactID = " & "'" & stWho & "'"
'-- Looks up email address from TblUsers
varTo = DLookup("[ContactEmail1]", "tblContacts", stWhere)

If IsNull(ContactEmail1) = True Then
variable = "Left blank"
End If

stSubject = "Remember to assign me to a request!"

stEmailID = Format(Me.EmailID, "00000")
RecDate = Me.EmailDate
'-- Helpdesk employee who assigns ticket
EmployeeID = Me.cmdEmployeeID.Column(1)

stText = Chr$(13) & "Email Reference: " & EmailID & Chr$(13) & _
"This email has been sent to you by: " & EmployeeID & _
Chr$(13) & "Sent On: " & RecDate & Chr$(13) & _
Chr$(13) & "This is an internal reference message"

'Write the e-mail content for sending to assignee
DoCmd.SendObject , , acFormatTXT, varTo, , , stSubject, stText, -1

'Set the update statement to disable command button
'once e-mail is sent
strSQL = "UPDATE tblEmail " & _
"SET tblEmail.EmailSent = -1 " & _
"Where tblEmail.EmailID = " & Me.EmailID & ";"


On Error GoTo Err_Execute
CurrentDb.Execute strSQL, dbFailOnError
On Error GoTo 0

'Requery checkbox to show checked
'after update statement has ran
'and disable send mail command button
Me.EmailSent.Requery
Me.EmailSent.SetFocus
Me.cmdSendEmail.Enabled = False

Exit Sub

Err_Execute:

' Notify user of any errors that result from
' executing the query.
If DBEngine.Errors.Count > 0 Then
For Each errLoop In DBEngine.Errors
MsgBox "Error number: " & errLoop.Number & vbCr & _
errLoop.Description
Next errLoop
End If

Resume Next


Exit_cmdSendEmail_Click:
Exit Sub

Err_cmdSendEmail_Click:
MsgBox Err.Description
Resume Exit_cmdSendEmail_Click

End Sub

Good Morning Everyone,

I am looking for some opinions on the fastest way to locate text within a text field and assign a value if specific text is matched.

So here is the scenario:

Lets say you need to locate the word WPV, NVM, and WKZ in everyrecord between a certain date and time.

So what I currently do is setup an array as a reference table with the ID for each of those words and have it go through each record checking for those letters. If it finds one then it saves the ID of that word to the current record.

So if the reference array looks like this:

1-WPV
2-NVM
3-WKZ

And it was looking at the following data:

1/21/2013 - 001WPV49085

I have a number of categories on which I assign a relative risk - at the moment H, M and L. Previously I had these set as a value selection combo and they were as 'text'.

More recently I have changed this now to a lookup and put the risk rating into a separate table. As a consequence the field is now 'numeric' but displays text from my combo.

When running a linked query I now get an error message instead of the required response.

My query should report back a 'Yes' if the queried cell contains an 'H' or 'M'.

Audiometry: IIf([tblRiskProfile]![Noise]="H" Or [tblRiskProfile]![Noise]="M","Yes","No")

However, this obviosuly doesn't work now because of the cell properties being numeric. How do I ammend the string above to run the same query?

Hi everyone, it may be a bit long to describe the situation, thanks for showing understand.

*************************************************
I work in a bank and am establishing a database for internal staff in my department to apply different event, such as golf day, soccer.



To make it simple, assumed that there is 3 teams in my department, each team can apply various events and then get tickets of events.
Each team can at most get the amount of tickets assigned by me.

To do this, I have a table call [tbl_event], there are 4 fields on it, namely,
"Event Name" --- the name of the events
"Team A " ---- maximum ticket assigned to Team A
"Team B " ---- maximum ticket assigned to Team B
"Team C " ---- maximum ticket assigned to Team C

for example,
Event name | Team A | Team B | Team C |
ABC event -----4---------- 5------- 6--------

which means that under ABC event, Team A can get 4 tickets at most.


i have form [frm_event], there is a combo box which row source is [tbl_event].[Event Name]
in this form, there is also a datasheet subform called [subform_event]

When team representive enter the form, they need to enter a password of their team, and then in the form there will be a textbox "Team Number" showing their team name , that is "Team A", "Team B" or "Team C", as a value

When a team representative of Team A choose particular event on the combobox of [frm_event], say ABC event, the subform will come out, and he can enter a number in a column of subform called "request ticket".
Finally I can know how much ticket they need in certain event by viewing the table/query

What I want to do is that, if they enter a number larger than the maximum number of tickets assigned, they can't update the subform and have to lower to number. (E.g. team A can only enter at most "4" as the number of ticket request under "ABC event", there will be msgbox warming them if number is larger than 4)

How can I establish a validation rule between the text box value "Team Number" and field of a table "Team A/B & C" ??


*********************************]
I hope it is clear enough, could someone tell me how can I achieve the above effect?
It is difficult for me to set a validation rule between a text box "Team Number" and a field of a table.


i appreciate so much if someone can give me some advice

Hi guyz can anybody help me?, i got a litte problem here :
i'm trying to send a data from a field of a query to a text box, here is what i do :
Option Compare Database
Dim dbs As Database
Dim rst As Recordset
Dim strCriteria As String

Private Sub Cmb_save_Click()
strCriteria = "[Borrow ID] = '" & Trim(Cmb_borrowID.Value) & "'"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Returning Query", dbOpenDynaset)
rst.FindFirst strCriteria

Txt_Media = rst![Media]
End Sub

but i got an error massage saying datatype missmatch,i found out that the problem occur because the data type of Borrow ID field from returning query
is auto number.it work if the data type is text.
my question is how to use rst.findfirst command to look for a record with numerical data type?

please help
please help

Hey there, Im currently making a form so users can enter project information. For this particular project, the user must choose from a variety of options, and each option has a number value assigned to it for a rating. Now at the end of this form, I want a sum of the ratings, and then entered into the table. I am using a text box for the sum of ratings, and can get the sum of ratings to work on the form, but this data is entered as a 0 in the table. If anyone could help me find a way to put the actual sum in the table, that would be excellent.. thx a lot.

If it would be any help, here are the names of text boxes that I'm adding:

Health and Safety Rating, Maintenance Rating, Equipment Rating, School Size Rating, Student Enrollment Rating, SD Priority Rating, Project Requested Previously Rating

Those ratings must be added into "Total Rating"

Thankyou!

Hey there, Im currently making a form so users can enter project information. For this particular project, the user must choose from a variety of options, and each option has a number value assigned to it for a rating. Now at the end of this form, I want a sum of the ratings, and then entered into the table. I am using a text box for the sum of ratings, and can get the sum of ratings to work on the form, but this data is entered as a 0 in the table. If anyone could help me find a way to put the actual sum in the table, that would be excellent.. thx a lot.

If it would be any help, here are the names of text boxes that I'm adding:

Health and Safety Rating, Maintenance Rating, Equipment Rating, School Size Rating, Student Enrollment Rating, SD Priority Rating, Project Requested Previously Rating

Those ratings must be added into "Total Rating"

Thankyou!

Hi

I am trying to build a report based on an existing form I use, i have the layout built already, however I have encountered a slight issue. I have a field [SNOW] which is a number between 1 and 9999 which normally goes in 4 seperate boxes on the form, so I have put 4 text boxes in and the following vb code to assign the numbers individually.

However despite there being records and [SNOW] being a required field with a number in i get a

Run-Time error '2427':
You entered an expression that has no value

which highlights the "If [SNOW] >= 1000 And [SNOW] < 2000 Then" line below

Thanks for looking! Thanks even more if you can save any of my hair!
Code: Private Sub Report_Open(Cancel As Integer) Dim snowhundreds As Integer Dim snowtens As Integer Dim snowsingle As Integer If IsNull([SNOW]) Then [SNOW] = 0 End If If [SNOW] >= 1000 And [SNOW] < 2000 Then Text689 = 1 ElseIf [SNOW] >= 2000 And [SNOW] < 3000 Then Text689 = 2 ElseIf [SNOW] >= 3000 And [SNOW] < 4000 Then Text689 = 3 ElseIf [SNOW] >= 4000 And [SNOW] < 5000 Then Text689 = 4 ElseIf [SNOW] >= 5000 And [SNOW] < 6000 Then Text689 = 5 ElseIf [SNOW] >= 6000 And [SNOW] < 7000 Then Text689 = 6 ElseIf [SNOW] >= 7000 And [SNOW] < 8000 Then Text689 = 7 ElseIf [SNOW] >= 8000 And [SNOW] < 9000 Then Text689 = 8 ElseIf [SNOW] >= 9000 And [SNOW] < 10000 Then Text689 = 9 Else Text689 = 0 End If snowhundreds = [SNOW] - ([Text689] * 1000) If snowhundreds >= 100 And snowhundreds < 200 Then Text691 = 1 ElseIf snowhundreds >= 200 And snowhundreds < 300 Then Text691 = 2 ElseIf snowhundreds >= 300 And snowhundreds < 400 Then Text691 = 3 ElseIf snowhundreds >= 400 And snowhundreds < 500 Then Text691 = 4 ElseIf snowhundreds >= 500 And snowhundreds < 600 Then Text691 = 5 ElseIf snowhundreds >= 600 And snowhundreds < 700 Then Text691 = 6 ElseIf snowhundreds >= 700 And snowhundreds < 800 Then Text691 = 7 ElseIf snowhundreds >= 800 And snowhundreds < 900 Then Text691 = 8 ElseIf snowhundreds >= 900 And snowhundreds < 1000 Then Text691 = 9 Else Text691 = 0 End If snowtens = [SNOW] - (([Text689] * 1000) + (Text691 * 100)) If snowtens >= 10 And snowtens < 20 Then Text691 = 1 ElseIf snowtens >= 20 And snowtens < 30 Then Text692 = 2 ElseIf snowtens >= 30 And snowtens < 40 Then Text692 = 3 ElseIf snowtens >= 40 And snowtens < 50 Then Text692 = 4 ElseIf snowtens >= 50 And snowtens < 60 Then Text692 = 5 ElseIf snowtens >= 60 And snowtens < 70 Then Text692 = 6 ElseIf snowtens >= 70 And snowtens < 80 Then Text692 = 7 ElseIf snowtens >= 80 And snowtens < 90 Then Text692 = 8 ElseIf snowtens >= 90 And snowtens < 100 Then Text692 = 9 Else Text692 = 0 End If snowsingle = [SNOW] - ((Text689 * 1000) + (Text691 * 100) + (Text692 * 10)) Text693 = snowsingle End Sub

I have Table1 with 2 fields:

ID - text field whose format is X123 (1 alphabet followed by 3 digits).
Date - Date format

I have a form whose control source is Table1.

I have assigned a default value = Date() to my textbox for "Date" control.

I want to assign a default value to the text box control for "ID" field on this form as follows:

If "Date" of the last record (order is determined by ascending order of the field "ID") is from last year (as compared to today's date), then
"ID" alphabet should advance by 1 and the "ID" number should be reset to "001"
Else
"ID" alphabet should be same as last record and the "ID" number should be last "ID" number + 1"


How to do this?

I know that this system wouldn't work after 26 years - since I only have 1 alphabet character - but that is ok.

Example:

Table1:

ID Date A001 1/1/2011 A002 7/19/2011 A003 12/18/2011 B001 1/4/2012 B002 4/6/2012

I get "2448 - You cannot assign a value to this object" When users try to increment the value via a "+" button I have made(see attached image). The strange part is that it's not all the time. Very random actually. So that is why i am reaching for help. Below is the code for the button.
The application is run using Access runtime 2010 SP1 in a .accdb format. I edit the application via access 2007.

Private Sub cmdSomeButtonClick_Click()
On Error GoTo err

Dim qty%

If IsNull([ReadonlyFieldInTheAttachedImage]) Then [ReadonlyFieldInTheAttachedImage] = 0

qty% = Val([ReadonlyFieldInTheAttachedImage])

qty% = qty% + 1

[ReadonlyFieldInTheAttachedImage] = qty%

Exit_cmdSomeButtonClick_Click:
Exit Sub

err:
MsgBox err.Number & err.Description
Exit Sub

Ok, so after looking at this. The text boxes control source is a number in the table. The code Val() is trying to convert a string to a number? Is this necessary if the control source is already a number? or is this necessary if the text box control is used?

as always your help is appreciated. Attached Thumbnails   Reply With Quote 07-12-2011, 07:44 AM #2 nkuebelbeck Advanced Beginner Windows 7 Access 2007 Join Date Mar 2010 Posts 81 Over complicated Couldn't I just go

[GreyedOutBox] = [GreyedOutBox] + 1

??

I am new to access, so please excuse ignorance. Within my table (contacts) I have a text field (other). What I am trying to do is collect all of the text input from the field 'other', separate each string by commas, and output to a single textbox on my report (othertext). Normally...I would go in and clean up the data or assign numbers to the text values, but in this instance that is counter productive. Can anyone help me with code to generate a string and then output it to a single text box in my report?

Many thanks in advance!

Inex

PS I have already tried to adapt http://www.access-programmers.co.uk/...ad.php?t=91540 without any success. Can anyone make an example for me using my table names...etc?

What I need are membership cards with sequential numbers (with the starting number entered by the user). Each number is assigned to a member and needs to be saved in a table.
To accomplish this I created a table and my own custom label that corresponds to the size of my membership card. I did this by using the label wizard. I then created an unbound text box when the user enters a starting number for the membership cards.
My problem is I have been unable to save the starting number (I tried to do a "update" query from the unbound text box but it never updates the table, only the displayed value) and I can not increment the starting number.

Can anybody tell me how to do this with out having to use a form? I want to be able to do this by just clicking on the report. This seems like it should be easy but the solution so far has evaded me.

Thank you all for your help in the past. I have created a report that will change dynamically depending on how many columns of data i have (was setup via crosstab). The report will run from a form button.

Currently in the report's load event we have code as follows:


	Code:
	Private Sub Report_Load()
Dim SuppCNT As String

SuppCNT = Me.SupplierCount.Value

If SuppCNT = 2 Then
    Me.Box2.SetFocus
    Me.Box2.text = 2
End If

End Sub

supplier count is another text box based on a query output, in the report. We would like to change the control source property of Box2 = 2 if the count is 2, etc.

The report must show up in print preview form. Is there another event this information should be in possibly in the button's on click event to have this trigger correctly? Or possibly changing to a label and set the caption to the field?

The reason for repointing the textbox is that depending on how many suppliers we have (assigns fields names [1],[2],[3],[4],[5],[6],[7]...) the report will error as the field [7] will not exist, if the data ends at [2].

We have gotten a number of errors in testing this, from the field does not exist (explained method above), to the current that we cannot set the property for print preview...

Thanks in advance.

The code below is in the click event on a button. Basically it is supposed to assign the next sequential number to a record.

I then have a text box on a form that pulls from a query that concatenates the sequential number with the year in the date field.

It worked at first, but once I got to the tenth record it started duplicating the number 10. So I set the the field in the table to indexed no duplicates. Also, for testing sake, I deleted a couple of in between records out. so that the numbers went like this: 6,7,10. When I created a new record, it assigned it to "8", and then the next, "9". Then when it got to 10 it wouldn't let it and said that whole shebang about there being duplicate records. I thought that the dmax would have started the whole numbering at 11 then 12 then 13.

So I then deleted the record with the 10 in it, and I still got the error, but when I look at the table, the 10 is now in a new record. Any help is greatly appreciated. This number is used as a sequential number for a nonconformance log, basically its for ISO purposes. And since I learned that autonumbers aren't the best to use for this type of purpose I am trying this. Any help is appreciated, even a suggestion for a different way to achieve my purpose is helpful .

EDIT: In the future, deletes will not be allowed, as it is a log, and Needs to remain for audit purposes.



	Code:
	Private Sub btnSaveNCR_Click()
On Error GoTo Err_btnSaveNCR_Click
    Me.EnterDate = Now()
    Me.NCRNUMBER = Nz(DMax("[NCRNumber]", "tblNonconformanceInformation", "Year([EnterDate]) =" & Year_
(Me.txtEnterDate)), 0) + 1
 
    DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , _
acMenuVer70
    Me.lstNCRNumDisplay.Requery
    Me.lstNCRNumDisplay.Visible = True
Exit_btnSaveNCR_Click:
    Exit Sub
Err_btnSaveNCR_Click:
    MsgBox Err.Description
    Resume Exit_btnSaveNCR_Click
 
End Sub



OK... In a previous thread I came out with some code that works and looks like this:


	Code:
	Private Sub Form_BeforeUpdate(Cancel As Integer)
'Sets ADO connection
Set MasterDbConn = CurrentProject.Connection
 
'Declarations
Dim rsNewRTId As ADODB.Recordset
 
'Dim rsNewRTIDSQL As String
Dim NewRTID As Integer
 
Set rsNewRTId = New ADODB.Recordset
 
'Add Record to tag relationships
Dim NewTagRelQRY As String
Dim AssignNCR As String
Dim NCRID As Integer
Dim fkTRID As Integer
 
NCRID = Me.Parent.txtNCRHeaderID
  
'SQL to create a new record in the tblTagRelationships
NewTagRelQRY = "Insert INTO tblTagRelationships(DateTimeStamp)" & _
" VALUES (Now());"
 
AssignNCR = "Update tblTagRelationships" & _
" Set fkNCRHeaderID =" & NCRID & _
" Where pkTagRelationshipID =" & fkTRID
 
'If the record is a new record then a Tag Relationship
'is created and assigned. But if it is not a new
'record then this has already been done, and there
'will be problems if it is given a new one.
If Me.NewRecord = True Then
 
    'This will add a new record in the tag relationships
    'and put that number into the tag foreign key
    With CurrentProject.Connection
        .Execute NewTagRelQRY
        NewRTID = .Execute("SELECT @@Identity")(0)
        Me.fkTagRelationshipID = NewRTID
        fkTRID = Me.fkTagRelationshipID
    End With
 
End If
 
'This will assign the current NCR to the tagrelationship
If Me.NewRecord = True Then
   CurrentProject.Connection.Execute AssignNCR
End If
End Sub

Currently this adds a new record to my table, "tblTagRelationships" by adding the current date and time to a new record. This date/time is really irrelevant to anything I am doing and is useless data given the help in a previous thread to do what I need in a better way.

What I found, though, is that now the bottom part of the code where I am adding "NCRID" to the newly created record doesn't work. And I thought, too, that it might be cleaner to use this NCRID to create the new record in "tblTagRelationships" instead of creating a useless date/time stamp.... The problem is that I get a run time error (The Red text is the items that the Blue text uses, and the blue text is what throws the error when I hit debug) :

Quote: Run-time error '2147217904(80040e10) No value given for one or more parameters I assume this means that the SQL isn't reading my "NCRID" value which is set to the current ID, and I don't know why, am I referring to it incorrectly? Here is the updated code:


	Code:
	Private Sub Form_BeforeUpdate(Cancel As Integer)
 
'Sets ADO connection
Set MasterDbConn = CurrentProject.Connection
 
'Declarations
Dim rsNewRTId As ADODB.Recordset
'Dim rsNewRTIDSQL As String
Dim NewRTID As Integer
Set rsNewRTId = New ADODB.Recordset
 
'Add Record to tag relationships
Dim NewTagRelQRY As String
Dim AssignNCR As String
Dim NCRID As Integer
Dim fkTRID As Integer
 
NCRID = Me.Parent.txtNCRHeaderID
  
'SQL to create a new record in the tblTagRelationships
NewTagRelQRY = "Insert INTO tblTagRelationships(fkNCRHeaderID)" & _
" VALUES (NCRID);"
 
AssignNCR = "Update tblTagRelationships" & _
" Set fkNCRHeaderID =" & NCRID & _
" Where pkTagRelationshipID =" & fkTRID
 
'If the record is a new record then a Tag Relationship
'is created and assigned. But if it is not a new
'record then this has already been done, and there
'will be problems if it is given a new one.
If Me.NewRecord = True Then
 
    'This will add a new record in the tag relationships
    'and put that number into the tag foreign key
    With CurrentProject.Connection
       .Execute NewTagRelQRY
        NewRTID = .Execute("SELECT @@Identity")(0)
        Me.fkTagRelationshipID = NewRTID
        fkTRID = Me.fkTagRelationshipID
    End With
 
End If
 
'This will assign the current NCR to the tagrelationship
If Me.NewRecord = True Then
    CurrentProject.Connection.Execute AssignNCR
End If
End Sub



Hi,
I wrote some access vba code that retrieves data from access, then creates a mail in Lotus Notes 8.5. The content of the mail is formatted text. The mail is usually send from a group mailbox but it can also be the default (user's) mailbox. When mail is sent directly, then the formatting is lost somewhere. In the send folder of notes it looks correct, but on the receiving side the formatting is gone.
However, when mail is first saved in the draft folder of the mailbox and then send manually from notes, the formatting stays correct both on sending and receiving side. I guess it must be something within the vba code. Any ideas ?
Here's the code :
Private Sub MailViaLotusNotes()
Dim objNotesDB As Object ' Notes Database
Dim objNotesDoc As Object ' Notes Document
Dim objNotesRTF As Object ' Notes Rich Text Item
Dim objNotesStyle As Object ' Notes Rich Text Style
Dim objSession As Object ' Notes Session
Dim SndTo As String
Dim SndCc As String
Dim msgSubject As String
Dim AutoSend As Boolean ' True/False is Email automatically sent
Dim itm As Variant
Dim EmbedObj(0 To 100) As Object ' Attachments
Dim sSRV As String ' Notes Server
Dim sDb As String ' Maildb name
Dim ErrMes As String

Dim rs As New ADODB.Recordset
Dim sSql As String

Dim PlTxt1 As String
Dim PlTxt2 As String
Dim PlTxt3 As String

Dim varHd As String 'HD = value of whdoc id.
Dim varHdFx As String 'HdFx = fixed text for whdoc id.
Dim varHd1 As String 'Hd1 = header values part 1
Dim varHdFx1 As String 'HdFx1 = header fixed text part 1
Dim varHd2 As String 'Hd2 = header values part 2
Dim varHdFx2 As String 'HdFx2 = header fixed text part 2

Dim iiPrb As Integer 'Problem id number.
Dim ssPrb As String 'Problem description.
Dim ssDtl As String 'Detail values.
Dim ssVal As String 'Next Problem description.
Dim ssDtlFx As String 'Detail fixed text.
Dim cctrl As Boolean 'used for tracking end of data.

'Set Variables
AutoSend = GetAutoSend ' False saves to drafts folder True would send straight away
SndTo = ""
cc = ""

'Create Email

sSRV = "" 'Set default mail server
sDb = "" 'Set default mailbox

On Error GoTo Err_Handler

'If group mailbox chosen, then get server address and mailbox name.
If Me.mlGroup.Value = 2 Then
GrpMlbxSrv = Nz(Me.cboCreatedBy.Column(2), "")
GrpMlBxDb = Nz(Me.cboCreatedBy.Column(3), "")
sSRV = GrpMlbxSrv
sDb = GrpMlBxDb
If GrpMlbxSrv = "" Then
MsgBox "No group mailbox found. The default will be used.!"
End If
End If

Set objSession = CreateObject("Notes.NotesSession")

Set objNotesDB = objSession.GetDatabase(sSRV, sDb) 'Default Users Notes Account.
'Insert Server and Database details
'to use group mailboxes
'Set Notes Text Styles

Set bodytext = objSession.CreateRichTextStyle
Set bodytext1 = objSession.CreateRichTextStyle
Set headings = objSession.CreateRichTextStyle
Set bottom = objSession.CreateRichTextStyle
Set restrict = objSession.CreateRichTextStyle
Set disclaimer = objSession.CreateRichTextStyle

'Build Text Style
'Headings
With headings
.NotesFont = 4
.FontSize = 10
.Bold = -1
.Underline = 0
.NotesColor = COLOR_BLACK
End With
'Main Text
With bodytext
.NotesFont = 4
.FontSize = 10
.Bold = 0
.Underline = 0
.NotesColor = COLOR_DARK_BLUE
End With

With bodytext1
.NotesFont = 4
.FontSize = 10
.Bold = -1
.Underline = -1
.NotesColor = COLOR_DARK_BLUE
End With

'Bottom text
With bottom
.NotesFont = 1
.FontSize = 10
.Bold = 0
.Underline = 0
.NotesColor = COLOR_BLACK
End With

'Open Notes Mail

' If objNotesDB.IsOpen = True Then
' Else
' objNotesDB.openmail
' End If

If sSRV = "" Then
' Assign the current user db to the db object. In case of group mailbox this is
' done earlier. In that case the next line would generate an "already open" error.
objNotesDB.openmail
End If

If (objNotesDB.IsOpen) Then
msgSubject = "WhDoc 07 : " & Me.txtCaseNbr & " " & " [" & Me.txtBiTrip & "] ["
msgSubject = msgSubject & Me.txtShipmNbr & "]"

'Retrieve mail addresses.
Call RetrieveEmailAddresses(SndTo, SndCc)
If SndTo = "" Then
Call GetDefaultMailAddresses(SndTo, SndCc)
End If
'if no default mailaddress exist then mail will not be send straight away but
'saved in draft mailbox.
If SndTo = "" Then
AutoSend = False
End If

Call GetHeaderText(varHd, varHdFx, varHd1, varHdFx1, varHd2, varHdFx2)

'Create a new message
Set objNotesDoc = objNotesDB.CreateDocument
objNotesDoc.ReplaceItemValue "SendTo", SndTo
objNotesDoc.ReplaceItemValue "CopyTo", SndCc
objNotesDoc.ReplaceItemValue "Subject", msgSubject
objNotesDoc.Principal = objNotesDB.Title

Set objNotesRTF = objNotesDoc.CreateRichTextItem("Body")
Set objAttachRTF = objNotesDoc.CreateRichTextItem("File")

'Build Body of email
With objNotesRTF
'Write header of whdoc to mail body.
.AppendStyle (headings)
.AppendText varHdFx
.AppendStyle (bodytext)
.AddNewLine 1
.AppendText varHd
.AddNewLine 1

.AppendStyle (headings)
.AppendText varHdFx1
.AppendStyle (bodytext)
.AddNewLine 1
.AppendText varHd1
.AddNewLine 1

.AppendStyle (headings)
.AppendText varHdFx2
.AppendStyle (bodytext)
.AddNewLine 1
.AppendText varHd2
.AddNewLine 1
'Write detail of whdoc to mail body.
cctrl = True
Do While Not cctrl = False
Call RetrieveWhDocDetail(iiPrb, ssPrb, ssDtl, ssVal, ssDtlFx, cctrl)
.AddNewLine 1
.AppendStyle (bodytext1)
.AppendText ssPrb
.AddNewLine 1
.AppendStyle (headings)
.AppendText ssDtlFx
.AddNewLine 1
.AppendStyle (bodytext)
.AppendText ssDtl
Loop
.AddNewLine 1

End With

'Add Attachments
sSql = "SELECT tbPics.picsPath FROM tbPics "
sSql = sSql & "WHERE (((tbPics.picsID)='"
sSql = sSql & [Forms]![frmCaseRegWHG]![txtCaseNbr] & "'))"

Set rs = New ADODB.Recordset
rs.Open sSql, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
If rs.EOF = True And rs.BOF = True Then
'...
Else
itm = 1
Do While Not rs.EOF = True
Set EmbedObj(itm) = objAttachRTF.EmbedObject _
(EMBED_ATTACHMENT, "File", rs.Fields(0).Value)
rs.MoveNext
itm = itm + 1
Loop
End If
rs.Close
Set rs = Nothing

'Get the mail to appear in sent items folder
objNotesDoc.SaveMessageOnSend = True
objNotesDoc.Save True, True

'Send the message
If AutoSend = True Then
'objNotesDoc.postedDate = Now()
Call objNotesDoc.ReplaceItemValue("PostedDate", Now())
Call objNotesDoc.Send(0)
End If
If AutoSend = True Then
MsgBox ("Mail send.")
Else
R = MsgBox("Mail has been prepared. See draft folder ! " & vbCrLf & _
"Change if needed before sending out.", vbInformation, "Notes Mail")
End If
'Markeer [MailSend] veld om aan te geven dat de mail verstuurd werd.
MailSend = -1
Me.frameMail.BorderColor = RGB(0, 255, 0)

Else
MsgBox ("Lotus Notes Could Not Be Opened."), vbInformation
End If

Set objNotesDB = Nothing
Set objSession = Nothing
Exit Sub
Err_Handler:
If Err.Number = 7225 Then 'Picture file not found or not existing
MsgBox Err.Description
Resume Next
Else
MsgBox Err.Number & " " & Err.Description
End If
ErrMes = "Lotus Notes could not create mail" & vbCrLf
ErrMes = ErrMes & "Maybe Notes screensaver is on or Alarm is displayed." & vbCrLf
ErrMes = ErrMes & "Check Lotus Notes first and try again."
MsgBox ErrMes, vbInformation

End Sub


Not finding an answer? Try a Google search.