Solved

Date validations!

Posted on 2002-03-04
8
153 Views
Last Modified: 2010-05-02
Hello!

My name is Assaf Lasry and I'm a junior programmer in VB6. I'm currently working on a software and I have a small problem. I have a database (MS Access) and I have a table called post that has 3 fields (InitialDate, Terms, Late). In my VB form I have a combobox, and a text box that has the current date. In the combobox, I have 3 options (30, 60, 90). Whenever i select an option(i.e. 30) and save the information, in the database, the terms field gets the value 30 and the InitialDate field gets todays date. Terms means the number of days. Now since my terms are 30, I want that when 30 days have passed, I'm suppose to get a 1 in the Late field. How can I do that and what my code suppose to look like. Please I need help. I would really appreciate your answer.

Thank you in advance,
Assaf Lasry!
0
Comment
Question by:AssafL
8 Comments
 
LVL 4

Expert Comment

by:srauda
ID: 6840175
What happens when terms are 60 or 90?
0
 
LVL 49

Expert Comment

by:Ryan Chong
ID: 6840299
Hi AssafL,

Maybe what you want is like this:

SQL = "Update myTable Set Late = 1 Where InitialDate + Terms < Date"
0
 
LVL 1

Expert Comment

by:Neo78
ID: 6840457
First of all, u need to calculate the date when 30, 60 or 90 days are added to the initial date (today's date). Here I'm storing the calculated date in a text box. U can use a variable instead.

For example, TermDate is the date when 30 days are added to the initial date.

TermDate= Format(DateAdd("d", CInt(Term), InitialDate), "dd mmm yyyy ")

Then u assign this code to the Late textbox...

Late = DateDiff("d", TermDate, Now)

Note that if TermDate is still early before Now(today's date), it will display a negative value. However, I'm sure u can easily modify this part to suit your needs.

Hope this is more or less what u r looking for.
Let us know.

Regards.
0
 
LVL 1

Expert Comment

by:Neo78
ID: 6840475
Note, if the current date is 2 days after the term date, it will display 2, 3 if 3 days late and so on. I'm sure this is what u need. :P All u need to do is add those two lines of code in the appropriate part of your program change the names as needed.

Regards.
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 17

Accepted Solution

by:
inthedark earned 200 total points
ID: 6840713
ryancys is right except that is for SQL server.

For Access:

1) Create a new query called say for example "u Find Late People".  In the design view, select "View - SQL" paste in the following code:

Update myTable Set Late = True Where InitialDate + Terms < Date

Now save the query.

2) Setup a Macro called say "Find Late People".

In the macro add the following lines:
SetWarnings No
OpenQuery "u Find Late People"
SetWarnings Yes

3) You can now run this macro before opening any views or reports for this file or:

4) Create a Macro called "Autoexec", you may already have one.

Add in the line:
RunMacro "Find Late People"

The Autorexec Macro is fired each time your Access database is started.

For VB:

Open your database using DAO or ADO.

Set DB=Workspaces(0).OpenDatabase("c:\MyDB.MDB")

SQL="Update myTable Set Late = True Where InitialDate + Terms < Date"
DB.Execute SQL

Hope this helps.

0
 
LVL 75

Expert Comment

by:Anthony Perkins
ID: 6840875
Please maintain your open questions.  For the record:

Questions Asked 19
Last 10 Grades Given A A A A A A A C D D  
Question Grading Record 11 Answers Graded / 11 Answers Received

Thanks,
Anthony
0
 
LVL 17

Expert Comment

by:inthedark
ID: 6843546
Here is a function that can perform a database backup/restore.
I place all my ADO functions in a class called zADO
 so in my program, after declaring ADO I just type "ADO." and up pop all my tools.

Dim ADO as New zADO
Dim OK as Boolean

' open your connection
CN.Open ' normally I do this in a function too.

' backup database
OK = ADO.BackatabaseOK(CN, "MyDatabase", "d:\MyDestination\File.bak")
If Not Ok Then
   Msgbox "Panic " + ADO.GetLastError(CN)
   Exit Sub
End If

' Restore database
OK = ADO.BackatabaseOK(CN, "MyDatabase", "d:\MyDestination\File.bak")
If Not Ok Then
   Msgbox "Panic " + ADO.GetLastError(CN)
   Exit Sub
End If


' here is an extract of the zADO Class
==================class module zADO

Public Function BackupDatabaseOK(CN As ADODB.Connection, DatabaseName As String, DestinationFile As String) As Boolean

' Backup a database

Dim SQL As String
Dim OK As Boolean
Dim RS As ADODB.Recordset

   
    SQL = "USE master" + vbCrLf
    SQL = SQL + "EXEC sp_addumpdevice 'disk', 'TMP_Backup', '" + DestinationFile + "'" + vbCrLf
    SQL = SQL + "BACKUP DATABASE " + DatabaseName + " TO TMP_Backup" + vbCrLf
    SQL = SQL + "EXEC sp_dropdevice 'TMP_Backup'" + vbCrLf
    SQL = SQL + "USE " + DatabaseName + vbCrLf
    On Error Resume Next
    Err.Clear
    CN.Execute SQL
    If Err.Number <> 0 Then
        OK = False
    Else
        OK = True
    End If
     
    ' reset current database for this connection
    SQL = "USE " + DatabaseName + vbCrLf ' re-issue incase last command did not read the en.d
    CN.Execute SQL
    BackupDatabaseOK = OK


End Function

Public Function RestoreDatabaseOK(CN As ADODB.Connection, DatabaseName As String, SourceFile As String) As Boolean

' Restore a database don't try master

Dim SQL As String
Dim OK As Boolean

SQL = "USE master" + vbCrLf
SQL = SQL + "EXEC sp_dboption '" + DatabaseName + "', 'offline', 'TRUE'" + vbCrLf
SQL = SQL + "RESTORE DATABASE " + DatabaseName + " FROM DISK = '" + SourceFile + "'" + vbCrLf
SQL = SQL + "EXEC sp_dboption '" + DatabaseName + "', 'offline', 'FALSE'" + vbCrLf

On Error Resume Next
Err.Clear
CN.Execute SQL
If Err.Number <> 0 Then
    OK = False
Else
    OK = True
End If
On Error GoTo 0
RestoreDatabaseOK = OK

End Function

Public Function GetLastError(CN As ADODB.Connection) As String

' Returns the last error on a connection

'Example:
' OK = ADO.ConnectOK(CN)
' If Not OK Then
'      MsgBox ADO.GetLastError(CN)

If CN Is Nothing Then
    GetLastError = "Connection is invalid"
    Exit Function
End If

Dim m$

Dim E As ADODB.Error
Dim Elist As ADODB.Errors
Set Elist = CN.Errors
For Each E In Elist
    m$ = m$ + CStr(E.Number) + " " + E.Description + " " + E.Source + " " + E.SQLState + vbCrLf
Next
   
GetLastError = m$

End Function
0
 
LVL 17

Expert Comment

by:inthedark
ID: 6847400
Woops, sorry I pasted the above code for a different question in error.

0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now