I am trying to have a message box appear when a duplicate number is entered. A duplicate in this table would be if BOTH fields match, [Source] and [Voucher_Number].
[Source] is formatted as text
[Voucher_Number] is formatted as Number
Here is what my code looks like:
If (IsNull(DLookup("Source", "tblInvoiceLog", "Source ='" &
Me.Source.Value & "'"))) And _
(IsNull(DLookup("Voucher_Number", "tblInvoiceLog", "Voucher_Number ='" &
Me.Voucher_Number.Value & "'"))) Then
Else
MsgBox "Duplicate Entery!" & Chr(13) & Chr(10) & "Please Use the Next
Available Consecutive Voucher Number", vbInformation, "Required"
End If
End Sub
I am getting:
Run Time error 3464
What I would ultimately like to do, aside from solve this problem, is in the message box return the value of the field in the [Vendor_Name] for the original entry.
Thank you for any help anyone can lend
You could try casting the DLookup return values specifically as strings to ensure you are comparing apples to apples. If you still get an error, use F8 to step through it and hover over s1stLookup and s2ndLookup to see what values are assigned to the variables.
Dim s1stLookup as String
Dim s2ndLookup as String
'Specifically cast the DLookup return values as Strings
s1stLookup = CStr(DLookup("Source", "tblInvoiceLog", "Source ='" & Me.Source.Value & "'"))
s2ndLookup = CStr(DLookup("Voucher_Number", "tblInvoiceLog", "Voucher_Number ='" & Me.Voucher_Number.Value & "'"))
If (IsNull(s1stLookup)) And (IsNull(s2ndLookup)) Then
'... Presumably some code here
Else
MsgBox "Duplicate Entery!" & vbCrLF & _
"Please Use the Next Available Consecutive Voucher Number", _
vbInformation, "Required"
End If
Currently you are testing for both values separately. But
A duplicate in this table would be if BOTH fields match, [Source] and [Voucher_Number].
So you need to test if both values exist in the same record by putting both conditions with AND into the DLookup call. And since you want to get the [Vendor_Name] if it is a duplicate, you can directly lookup this field:
Dim sVendor as String
sVendor = Nz(DLookup("Vendor_Name", "tblInvoiceLog", _
"Source = '" & Me.Source & "' AND Voucher_Number = " & Me.Voucher_Number), "")
If sVendor <> "" Then
MsgBox "Duplicate entry of vendor '" & sVendor & "'."
Else
' ok, no dupe
End If
I find it's best to always use Nz() with DLookup() so I can work with strings instead of variants. An empty string means there was no result.
Related
I have an Access database to report on event statistics gathered from a mainframe system. The mainframe scheduler (ZEKE) doesn't have robust reporting features, so I export daily event data to report on.
A master listing from a separate source (a static list that will not change on a regular basis) lists the individual applications, including the application code (which is the naming standard for production runs) and the name of the programmer, coordinator, manager, business unit, etc. for that application.
The user can search by any field, application code, programmer, coordinator, etc.
Choose the production center to search in (there are 5) or default to all, and choose all dates, a single date, or a date range.
The query takes the search parameters and starting with either the application code, or the person, searches the table for applications and copies records to a temp table for reporting.
For example, to see how many failures the application coordinator John Doe had for the past week for all of the applications he is responsible for, the query would move all application records listing John Doe as the coordinator to the temp table.
From there, it moves through the temp table for each application and searches the event data for events under that application code which meet the criteria entered for date, production center and event type (success, failure or both).
This is moved to a temp table for the final report.
The table for event data is currently 2.5 million lines (this is 15 days worth of data) and is growing daily.
I put the back end onto a newly created NAS drive on our network.
A report that took two minutes when the back end and front end were on the same machine now takes 29 minutes.
Any suggestions to streamline the queries over a network?
Code which is run from the report criteria selection form and runs the report.
'this macro will generate a report based on multiple input criteria.
'this report allows the user to slect:
' date range, single date or all dates
' type of events: Abends, Successes or both
' centers to pull data from: OCC,QCC,BCC,ITS,DAIN, or ALL centers
' The type of data to report on: App code, App Coordinator, Custodian, L3, L4 or L5
'Once the user has selected all of the required data and fields, the report will be generated
'based on the selection criteria.
'we begin by defining the active database as the currently open database
Dim db As DAO.Database
Set db = DBEngine(0)(0)
On Error GoTo ErrorHandler
'Now we designate the variables which will be used in this macro
Dim strSQ1 As String
Dim strSQ2 As String
Dim strSQ3 As String
Dim strSQ4 As String
Dim appl As String
Dim evstatus As String
Dim appletype As String
Dim fullapp As String
Dim length As Long
Dim iipmname As String
Dim iipmcoor As String
Dim fullappnm As String
Dim fullappcoor As String
Dim kinddate As String
Dim coor As String
Dim cust As String
Dim appL3 As String
Dim appL4 As String
Dim appL5 As String
Dim ctrOCC As String
Dim ctrMTL As String
Dim ctrBCC As String
Dim ctrITS As String
Dim ctrDAIN As String
'We will start by setting some default values
'We will ste the default values for center selection.
'We start by searching for terms we know are not there, then change them to
'valid search terms if the center is selected.
ctrOCC = "notOCC"
ctrMTL = "notMTL"
ctrBCC = "notBCC"
ctrITS = "notITS"
ctrDAIN = "notUSWM"
fullapp = "*"
'First we determine which event types the user wants to look for
state = Me![opt-status].Value
If state = 1 Then
evstatus = " [ev-status] = 'AEOJ'"
ElseIf state = 2 Then
evstatus = " [ev-status] = 'EOJ'"
ElseIf state = 3 Then
evstatus = " ([ev-status] = 'EOJ' OR [ev-status] = 'AEOJ')"
End If
'MsgBox "Event status pulled is:.. " & evstatus & "."
' Next up we will configure the date parameters based on the user input
If [grp-datesel] = 1 Then
Sdte = "1"
Edte = "9999999"
kinddate = "[ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & " "
End If
If [grp-datesel] = 2 Then
'error handling
If IsNull(Me.[sel-onedate]) Then
MsgBox "You have not entered a date to search....please try again."
Me.[sel-onedate] = Null
Me.[sel-onedate].SetFocus
Exit Sub
End If
'end of error handling
Dim currdte As Date
currdte = Me![sel-onedate].Value
currjul = Format(currdte, "yyyyy")
daycurr = CDbl(currjul)
Sdte = daycurr
Edte = daycurr
kinddate = "[ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & " "
End If
If [grp-datesel] = 3 Then
'error handling
If IsNull(Me.[sel-Sdate]) Or IsNull(Me.[sel-Edate]) Then
MsgBox "You Must enter a start and end date for the search....please try again."
Me.[sel-Sdate] = Null
Me.[sel-Edate] = Null
Me.[sel-Sdate].SetFocus
Exit Sub
End If
'end of error handling
Dim startdte As Date
Dim enddte As Date
startdte = Me.[sel-Sdate].Value
enddte = Me.[sel-Edate].Value
startjul = Format(startdte, "yyyyy")
endjul = Format(enddte, "yyyyy")
Sday = CDbl(startjul)
Eday = CDbl(endjul)
Sdte = Sday
Edte = Eday
'MsgBox "start date is " & Sdte & " and end date is " & Edte & "."
'check that dates are in proper chronological order
If Sdte > Edte Then
MsgBox "The start Date you entered is after the end date....please try again."
Me.[sel-Sdate] = Null
Me.[sel-Edate] = Null
Me.[sel-Sdate].SetFocus
Exit Sub
End If
'keep going if it's all good
kinddate = "[ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & " "
End If
MsgBox "Date used is:.. " & kinddate & "."
'Now lets look at center selection
If [chk-allctr].Value = True Then
ctrOCC = "OCC"
ctrMTL = "MTL"
ctrBCC = "BCC"
ctrITS = "ITS"
ctrDAIN = "USWM"
End If
If [chk-OCC].Value = True Then
ctrOCC = "OCC"
End If
If [chk-MTL].Value = True Then
ctrMTL = "MTL"
End If
If [chk-BCC].Value = True Then
ctrBCC = "BCC"
End If
If [chk-RTF].Value = True Then
ctrITS = "ITS"
End If
If [chk-DAIN].Value = True Then
ctrDAIN = "DAIN"
End If
'Error handling if no center is selected
If [chk-OCC].Value = Flase Then
If [chk-MTL].Value = Flase Then
If [chk-BCC].Value = Flase Then
If [chk-RTF].Value = Flase Then
If [chk-DAIN].Value = Flase Then
MsgBox "You have not selected a center to search search....please try again."
Me.[chk-allctr].SetFocus
Exit Sub
End If
End If
End If
End If
End If
'end of error handling
'MsgBox "centers used are: Chr(10) " & ctrOCC & " Chr(10) " & ctrBCC & " Chr(10) " & ctrMTL & " Chr(10) " & ctrITS & " Chr(10) " & ctrDAIN & " For this run"
'All good so far, now we will parse the application code if an
'application code report is selected
appl = "*"
If [opt-criteria].Value = 1 Then
'error handling
If IsNull(Me.[sel-appcode]) Then
MsgBox "You have not entered an application code to search....please try again."
Me.[sel-appcode] = Null
Me.[sel-appcode].SetFocus
Exit Sub
End If
'end of error handling
End If
If [opt-criteria].Value = 1 Then
appl = Me![sel-appcode].Value
End If
'trust = "no"
'If Mid(appl, 3, 2) = "RT" Then trust = "yes"
'length = Len(appl)
'If length = 2 Then appltype = "short"
'If length = 3 Then appltype = "long"
'If appltype = "short" Then fullapp = "" & appl & "00"
'If appltype = "long" Then fullapp = "" & appl & "0"
'If trust = "yes" Then fullapp = appl
'End If
fullapp = appl
'MsgBox "App to use is: " & appl & " fullapp code is " & fullapp & "."
'Now we set values if names are used
coor = "*"
cust = "*"
appL3 = "*"
appL4 = "*"
appL5 = "*"
If [opt-criteria].Value = 2 Then
'error handling
If IsNull(Me.[sel-coor]) Then
MsgBox "You have not entered a Coordinator to search....please try again."
Me.[sel-coor] = Null
Me.[sel-coor].SetFocus
Exit Sub
End If
'end of error handling
coor = Me![sel-coor].Value
'MsgBox "Coordinator report selected for: " & coor & "."
End If
If [opt-criteria].Value = 3 Then
'error handling
If IsNull(Me.[sel-custodian]) Then
MsgBox "You have not entered a Custodian to search....please try again."
Me.[sel-custodian] = Null
Me.[sel-custodian].SetFocus
Exit Sub
End If
'end of error handling
cust = Me![sel-custodian].Value
'MsgBox "Custodian report selected for: " & cust & "."
End If
If [opt-criteria].Value = 4 Then
'error handling
If IsNull(Me.[sel-L3]) Then
MsgBox "You have not entered an L3 to search....please try again."
Me.[sel-L3] = Null
Me.[sel-L3].SetFocus
Exit Sub
End If
'end of error handling
appL3 = Me![sel-L3].Value
'MsgBox "L3 report selected for: " & appL3 & "."
End If
If [opt-criteria].Value = 5 Then
'error handling
If IsNull(Me.[sel-L4]) Then
MsgBox "You have not entered an L4 to search....please try again."
Me.[sel-L4] = Null
Me.[sel-L4].SetFocus
Exit Sub
End If
'end of error handling
appL4 = Me![sel-L4].Value
'MsgBox "L4 report selected for: " & appL4 & "."
End If
If [opt-criteria].Value = 6 Then
'error handling
If IsNull(Me.[sel-L5]) Then
MsgBox "You have not entered an L5 to search....please try again."
Me.[sel-L5] = Null
Me.[sel-L5].SetFocus
Exit Sub
End If
'end of error handling
appL5 = Me![sel-L5].Value
'MsgBox "L5 report selected for: " & appL5 & "."
End If
'Most of these reports take a while to build with this macro, so to make sure the user
'knows that the macro is still working, we didsplay a splash screen. It's cute and has
'hamsters, cause everyone loves hamsters.
DoCmd.OpenForm "PlsWaitFrm", acWindowNormal
[Forms]![PlsWaitFrm].Repaint
'All of out criteria values are now selected. We can move on to pulling data from the tables.
'We start by populating the IIPM table with the information that we require for applications.
strSQ1 = "DELETE * from [tbl-RPT-IIPM] "
db.Execute strSQ1
strSQ2 = "INSERT INTO [tbl-RPT-IIPM] " & _
"SELECT * FROM [tbl-IIPM] " & _
"WHERE (([AppCode] like '" & fullapp & "')" & _
"AND ([AppCoordinator] like '" & coor & "') " & _
"AND ([AppCustodian] like '" & cust & "') " & _
"AND ([L3] like '" & appL3 & "') " & _
"AND ([L4] like '" & appL4 & "') " & _
"AND ([L5] like '" & appL5 & "')) "
db.Execute strSQ2
'MsgBox "made it past the populate of rpt-iipm"
'Now we have populated the IIPM report table, it's time to populate the event report table.
'We will loop through all fields in the IIPM report table and pull information for each
'application code.
strSQ3 = "DELETE * from [tbl-EVENTREPORT] "
db.Execute strSQ3
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl-RPT-IIPM") 'this opens the IIPM report table just populated
'populate the table
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
'we will execute these action against the selected record.
'first step - parse the application code to display the full application code
appl = rs![AppCode].Value
length = Len(appl)
If length = 1 Then appl = "" & appl & "00"
rptdelin = Mid(appl, 3, 1)
rptcode = Mid(appl, 1, 3)
If rptdelin = "0" Then rptcode = Mid(appl, 1, 2)
If rptdelin = "R" Then rptcode = "RT" & Mid(appl, 1, 2) & ""
'MsgBox "searching for: " & rptcode & "."
applist = applist & "," & appl
strSQ4 = "INSERT INTO [tbl-EVENTREPORT] " & _
"SELECT * FROM [tbl-EVENT DATA] " & _
"WHERE (([ev-jobname] LIKE '?" & rptcode & "*') " & _
"AND (([ev-ctr] = '" & ctrOCC & "')" & _
"OR ([ev-ctr] = '" & ctrMTL & "')" & _
"OR ([ev-ctr] = '" & ctrBCC & "')" & _
"OR ([ev-ctr] = '" & ctrITS & "')" & _
"OR ([ev-ctr] = '" & ctrDAIN & "'))" & _
"AND (" & kinddate & ") " & _
"AND " & evstatus & ")"
db.Execute strSQ4
'now we're done with this report, we move on to the next
rs.MoveNext 'press Ctrl+G to see debuG window beneath
Loop
'END OF LOOPING CODE
'MsgBox "made it past the looping"
'Now we have completed populating the table that the report will be based on.
'Next step is to gather master statistics to produce abend and success percentages.
totfail = DCount("[ev-status]", "tbl-EVENTREPORT", "[ev-status] = 'AEOJ'")
totsucc = DCount("[ev-status]", "tbl-EVENTREPORT", "[ev-status] = 'EOJ'")
Dim allabend As Long
Dim allsucc As Long
allabend = DCount("[ev-status]", "[tbl-EVENT DATA]", "[ev-status] = 'AEOJ' AND ([ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & ")")
allsucc = DCount("[ev-status]", "[tbl-EVENT DATA]", "[ev-status] = 'EOJ' AND ([ev-date] >= " & Sdte & " AND [ev-date] <= " & Edte & ")")
Dim pctabend As Long
Dim pctsucc As Long
pctabend = (totfail / allabend) * 100
pctsucc = (totsucc / allsucc) * 100
'Now we will generate the reports for display based on what type of report was selected
'by the user in the initial form.
'Before we open the report, we will close the splash screen
DoCmd.Close acForm, "PlsWaitFrm", acSaveNo
'Now we open the report
If [opt-criteria].Value = 1 Then
fullappnm = DLookup("AppName", "tbl-RPT-IIPM", "AppCode = '" & fullapp & "' ")
fullappcoor = DLookup("AppCoordinator", "tbl-RPT-IIPM", "AppCode = '" & fullapp & "' ")
DoCmd.OpenReport "rpt-APPLREPORT", acViewReport
[Reports]![rpt-APPLREPORT]![rpt-appcode].Value = fullapp
[Reports]![rpt-APPLREPORT]![rpt-appname].Value = fullappnm
[Reports]![rpt-APPLREPORT]![rpt-appcoor].Value = fullappcoor
[Reports]![rpt-APPLREPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-APPLREPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-APPLREPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-APPLREPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 2 Then
DoCmd.OpenReport "rpt-COORREPORT", acViewReport
[Reports]![rpt-COORREPORT]![rpt-appcode].Value = applist
[Reports]![rpt-COORREPORT]![rpt-appcoor].Value = coor
[Reports]![rpt-COORREPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-COORREPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-COORREPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-COORREPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 3 Then
DoCmd.OpenReport "rpt-CUSTREPORT", acViewReport
[Reports]![rpt-CUSTREPORT]![rpt-appcode].Value = applist
[Reports]![rpt-CUSTREPORT]![rpt-appcoor].Value = cust
[Reports]![rpt-CUSTREPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-CUSTREPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-CUSTREPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-CUSTREPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 4 Then
DoCmd.OpenReport "rpt-L3REPORT", acViewReport
[Reports]![rpt-L3REPORT]![rpt-appcode].Value = applist
[Reports]![rpt-L3REPORT]![rpt-appcoor].Value = appL3
[Reports]![rpt-L3REPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-L3REPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-L3REPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-L3REPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 5 Then
DoCmd.OpenReport "rpt-L4REPORT", acViewReport
[Reports]![rpt-L4REPORT]![rpt-appcode].Value = applist
[Reports]![rpt-L4REPORT]![rpt-appcoor].Value = appL4
[Reports]![rpt-L4REPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-L4REPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-L4REPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-L4REPORT]![rpt-succpct].Value = pctsucc
End If
If [opt-criteria].Value = 6 Then
DoCmd.OpenReport "rpt-L5REPORT", acViewReport
[Reports]![rpt-L5REPORT]![rpt-appcode].Value = applist
[Reports]![rpt-L5REPORT]![rpt-appcoor].Value = appL5
[Reports]![rpt-L5REPORT]![rpt-abendtot].Value = totfail
[Reports]![rpt-L5REPORT]![rpt-succtot].Value = totsucc
[Reports]![rpt-L5REPORT]![rpt-abdpct].Value = pctabend
[Reports]![rpt-L5REPORT]![rpt-succpct].Value = pctsucc
End If
ErrorHandler:
If Err.Number = 7874 Then
Resume Next 'Tried to delete a non-existing table, resume
End If
End Sub
'''
Firstly, you need to work out where the bottlenecks are, so I would suggest putting some Debug.Print Now statements throughout the code to give you an idea of what is causing the issue.
I would guess that two of the processes that take most of the time are the DELETE/INSERT statements that you are doing.
I would suggest that rather than doing this, you look at normalizing your database, and then creating a query that provides the information that you need.
Also, by running the report directly from a query rather than a temporary table means that you don't have to worry about the deletes/inserts creating database bloat.
If you really insist on keeping this process, then consider deleting the table [tbl-RPT-IIPM] and then recreating it, rather than deleting the records. And consider removing the indexes before the insert, and then adding them back afterwards, as indexes splow down inserts, but obviously speed up searches and joins.
Also, when you are inserting data into [tbl-RPT-IIPM], you are using ([L3] like '" & appL3 & "'), which is the same as ([L3]='" & appL3 & "'), but slower.
When you are inserting data into [tbl-EVENTREPORT], you are doing it when looping through a recordset - it may be faster to use an INSERT SQL statement.
Regards,
OK, with some more information, some more answers that may (or may not!!) help. Again, you will need to run timing tests to see which works best for you.
Try adding a "Yes/No" field to the table [tbl-EVENT DATA]. You can then use an UPDATE statement to indicate which fields to include in the report, rather than using the slow INSERT query.
Another thing to try would be to replace the INSERT statement with several, each using a different value for [ev-ctr]. Or else rather than using OR try using IN:
strSQ4 = "INSERT INTO [tbl-EVENTREPORT] " & _
"SELECT * FROM [tbl-EVENT DATA] " & _
"WHERE [ev-jobname] LIKE '?" & rptcode & "*' " & _
"AND [ev-ctr] IN('" & ctrOCC & "','" & ctrMTL & "','" & ctrBCC & "','" & ctrITS & "','" & ctrDAIN & "')" & _
"AND " & kinddate & _
"AND " & evstatus
Also, I notice that kinddate is set to effectively include all dates in one instance, and that evstatus is set to include both "EOJ" and "AEOJ" in one instance. Rather than including these fields as criteria in these cases, you may wish to not include them at all:
If state = 1 Then
evstatus = " AND [ev-status] = 'AEOJ'"
ElseIf state = 2 Then
evstatus = " AND [ev-status] = 'EOJ'"
ElseIf state = 3 Then
evstatus = " "
End If
And then you would rewrite " AND " & evstatus to & evstatus in the SQL statement.
A final thing to look at is to actually run the INSERT directly in the backend, rather than operating on linked tables in the frontend, as Access will be dragging vast amounts of data across the network and then sending it back. As a basic guide, something like this:
Sub sUpdateQuery()
Dim objAccess As New Access.Application
objAccess.OpenCurrentDatabase "J:\downloads\test.accdb"
objAccess.DoCmd.RunSQL "UPDATE test2 SET Field1=UCASE(Field1);"
objAccess.CloseCurrentDatabase
Set objAccess = Nothing
End Sub
Regards,
Applecore, Firstly, let me thank you for your insights. Unfortunately due to the nature of the way the data is processed, some of them I'm not sure I can implement. I have used debug.print statements to get a better idea of the timing.
You are correct, the INSERT statement is causing me the most problems, and only the second one. The deletes fly through almost instantly, no issues there. It's the second insert from the event data that is slowing it down.
I have been thinking about this since inception of how to nromalize more efficiently and create better relationships, but I'm stymied. My issue is, the data between the event table and the event table are related "in the world" but in no clear way in terms of data. There is no way to determine the relationship without a complex calculation. For example, the unique part of the application data is the application code. They are always unique. A single Application coordinator can have dozens of codes assigned to them, as can custodians, L3,L4, etc. Each event is related to an application, however, there is no specific field that is exported that tells the application code, it is obtained by parsing the event name (And yes, that is as archaic as it sounds). The event naming standards are standard mainframe 8 character names: .
For example PGRD1234 - Production job, GRD application, 1234 as the designator. So to determine what application the job is related to, I take the application code, and select LIKE with wildcards. It's not 100% accurate I am well aware, but to use wildcards, I seem to be stuck using LIKE. I haven't been able to make '=' work with wildcards. Can you?
You also mentioned "When you are inserting data into [tbl-EVENTREPORT], you are doing it when looping through a recordset - it may be faster to use an INSERT SQL statement." which I'm not sure what you are saying.. My apologies. I don't think I am understanding it. I think that is what I am doing now. I use the IIPM table to obtain the listing of the application codes I need to pull, then loop through that recordset to pull all of the event data for only those applications. As there is no direct correlation between the data, I Can't think of another way to do it.
I use the following code to add, edit data in table with form. All works fine, but there is one field which is in date format. I choose the date in the form with date pick up window, but when it imports it to the table it changes the date format from the UK date format to US.
For example I choose 01/11/2014 (1-nov-2014) in the date pick up window in form, and when I add the records to the table, (what I can see in the subform too) it shows 11/01/2014 (11-jan-2014). When I edit the same record with same form it still shows the 11/01/2014. So basically it changes the day and the month.
I've tried to put like 29/11/2014 then it didn't swap the day and the month. I've checked the region setting in control panel, it shows UK, I've tried to make format in my subform, I added the mm-dd-yyyy format to sql, but non of them helped.
Any idea how could I set this?
Thanks for any help
Option Compare Database
Private Sub cmdAdd_Click()
If Me.txtName.Tag & "" = "" Then
CurrentDb.Execute "INSERT INTO [import]([product name], [QtyImport], [ImportDate])" & _
" VALUES('" & Me.txtName & "'," & Me.txtOrderedQty & ",#" & Me.txtDate & "#)"
Else
CurrentDb.Execute "UPDATE import " & _
" SET [product name] = '" & Me.txtName & "'" & _
", [QtyImport] = " & Me.txtOrderedQty & "" & _
", [ImportDate] = #" & Me.txtDate & "#" & _
" WHERE [product name] = '" & Me.txtName.Tag & "'"
End If
cmdClear_Click
importSubform.Form.Requery
End Sub
Private Sub cmdClear_Click()
Me.txtName = ""
Me.txtOrderedQty = ""
Me.txtDate = ""
Me.txtName.SetFocus
Me.CmdEdit.Enabled = True
Me.CmdAdd.Caption = "Add"
Me.txtName.Tag = ""
End Sub
Private Sub CmdEdit_Click()
If Not (Me.importSubform.Form.Recordset.EOF And Me.importSubform.Form.Recordset.BOF) Then
With Me.importSubform.Form.Recordset
Me.txtName = .Fields("product name")
Me.txtOrderedQty = .Fields("QtyImport")
Me.txtDate = .Fields("ImportDate")
Me.txtName.Tag = .Fields("Product Name")
Me.CmdAdd.Caption = "Update"
Me.CmdEdit.Enabled = False
End With
End If
End Sub
Private Sub cmdExit_Click()
DoCmd.Close
End Sub
First parse the inputed date value to a datetime object then pass it's value to DB.
While binding again get the datetime object from the value in database then parse it to get value in 'dd-mm-yy' format.
Alternatively, you can also use the convert method to get date object from your inputed date value which is in 'dd-mm-yy' format i.e.
convert(date, #inputed, 103)
It will give date object where #inputed is your inputed date value.
Then store it in database and while displaying it again convert it back to 'dd-mm-yy' format using the following function.
convert(varchar, #savedDate, 103)
This line will be modified as follows:
CurrentDb.Execute "INSERT INTO [import]([product name], [QtyImport], [ImportDate])" & _
" VALUES('" & Me.txtName & "'," & Me.txtOrderedQty & ",convert(date, '" & Me.txtDate & "',103)"
I hope this above line is correct, correct if wrong as I work i, in C#.
OK So finally I found out how to format date in VBA. I've changed the "values" line in the cmd add click to the following :
" VALUES('" & Me.txtName & "'," & Me.txtOrderedQty & ",#" & Format(Me.txtDate, "mm/dd/yyyy") & "#)"
So this is the code what is actually working to keep everything in UK date format, bcs I read somewhere that VBA always use US date format, no matter u have set your region etc..
Im working on my first useable practice app to help people I work with run simple queries without having to know SQL.
I have a simple form, with 4 textbox entries. columns, table, condition column, condition
what I am wanting is to run the query without the where statement if the condition column is blank, or run the conditional statement if there is something there.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles CMDQuery.Click
If Columntxtbox.Text <> "" Then
If SQL.HasConection = True Then
If Conditioncolumntxtbox.Text = "" Then
SQL.runquery("Select " & Columntxtbox.Text & " from " & tabletxtbox.Text)
Else
SQL.runquery("Select " & Columntxtbox.Text & " from " & tabletxtbox.Text & " Where " & Conditioncolumntxtbox.Text & " like'%" & conditiontxtbox.Text & "%'")
If SQL.sqldataset.Tables.Count > 0 Then
DGVData.DataSource = SQL.sqldataset.Tables(0)
End If
End If
End If
End If
End Sub
what's happening is when I fill out all the fields, it works fine, when I try to enter just the column and table field, nothing happens. I'm thinking it has to do with the third If (if I change the = to <> then I get error with keyword like when column and city is filled and nothing when all are filled )
any help would be appreciated
thanks
A part from the missing spaces, you don't show the results of the query when there is no condition
If Columntxtbox.Text <> "" Then
If SQL.HasConection = True Then
If Conditioncolumntxtbox.Text = "" Then
SQL.runquery("Select " & Columntxtbox.Text & " from [" & tabletxtbox.Text & "]")
Else
SQL.runquery("Select " & Columntxtbox.Text & " from [" & tabletxtbox.Text & _
"] Where [" & Conditioncolumntxtbox.Text & "] like '%" & _
conditiontxtbox.Text & "%'")
End If
If SQL.sqldataset.Tables.Count > 0 Then
DGVData.DataSource = SQL.sqldataset.Tables(0)
End If
End If
End If
However keep in mind that it is a very bad practice to leave your user type directly the values, column names and other part of text that will be added to your sql text without checks. The user can type anything and you could find a malicious user that know about sql injection and ruin your life.
Given the context and the requirements, (a practice app) I think that you could ignore the problem for the moment. But again, in a real context scenario where data is the most important thing that your customers have, leaving holes of this magnitude is really unprofessional.
Working on a script in Microsoft VBA to take a massive flat database and split it between about 20 different tables. The script consists mainly of opening a table, checking every row in the flat database to make sure it's not a duplicate, then adding the necessary fields. Repeat for every table.
The first time I ran it everything was going well until I tried to process the name O'Malley. I think it's obvious what went wrong. A quick search on Google turned up this related StackOverflow post. I took their advice and added Replace(str, "'", "''") to every field before inputting it into the new tables. Now I've run into a new problem and Google is less helpful.
Replace(null, "'", "''") causes a run-time error, and the flat database is just riddled with null values. I can add an extra line above every Replace() call to check IsNull() and if so put null into the database instead of Replace(str, "'", "''"), although I would prefer a solution that can fit into a single line if possible. Is there any more elegant way to solve this dilemma, or will I need 216 If statements in my code?
EDIT -
Another reason that I'm searching for a more elegant solution is my duplicate checking code. At the moment I have something like the following:
'Check for duplicates
'Assume student is duplicate if it shares:
' (StudentName and School) or SSN
Set rstDuplicate = CurrentDb.OpenRecordset("select * from Student where (StudentName = '" & Replace(rstFrom("Student").Value, "'", "''") & "' AND School = '" & Replace(rstFrom("School").Value, "'", "''") & "') OR SSN = '" & Replace(rstFrom("Social").Value, "'", "''") & "'")
If rstDuplicate.RecordCount = 0 Then
'Duplicate was not found
rstTo.AddNew
' Add fields to the new table
rstTo.Update
End If
Since the Replace() calls are inline with the duplicate checking, if I were to instead use If statements to check for null then I would have to either save the result to a string or update to flat database. A function that returns Replace(str, "'", "''") OR null without the need for extra variables would be ideal.
If you want to keep everything inline, you can use an immediate If function (IIf):
IIf(IsNull(rstFrom("Student").Value), " Is Null", "= " & Replace(rstFrom("Student").Value)
That will be a nightmare to read and maintain, though. You are better off writing your own function to handle the change in comparison operator as well as the apostrophe escaping:
Function CompFld(Val As Variant) As String
If IsNull(Val) Then
CompFld = " Is Null "
Else
CompFld = "= '" & Replace(Val, "'", "''") & "' "
End If
End Function
Use it as so:
Dim SQL As String
SQL = "SELECT * FROM Student " & _
"WHERE (StudentName " & CompFld(rstFrom("Student").Value) & " AND " & _
" School " & CompFld(rstFrom("School").Value) & ") " & _
" OR (SSN " & CompFld(rstFrom("Social").Value) & ") "
Set rstDuplicate = CurrentDb.OpenRecordset(SQL)
If rstDuplicate.RecordCount = 0 Then
'Duplicate was not found
rstTo.AddNew
' Add fields to the new table
rstTo.Update
End If
A terse, yet ugly little gem handed down to me from ages ago:
Replace(str & "", "'", "''")
Appending an empty string to a null value returns an empty string in VBA, and won't modify a non-empty string.
Access' database engine will accept either single or double quotes as delimiters for string values in queries. So instead of ...
SELECT * FROM Student WHERE StudentName = 'O''Malley'
... you can do this ...
SELECT * FROM Student WHERE StudentName = "O'Malley"
That would allow you to handle inputs which contain apostrophes. OTOH, if your string inputs also contain double quotes, this will break.
I suspect you may have more going on than just the apostrophe issue, but I don't understand your big picture. You seem to be opening a third DAO recordset for each record in rstFrom, to check whether a match exists in the Student table. I would use DCount() instead.
Dim strCriteria As String
strCriteria = "StudentName = ""O'Malley"" AND School = ""foo"""
If DCount("*", "Student", strCriteria) = 0 Then
'no match found --> add it '
End If
I have craeted code which reads the acc no, rtn, name and amt from text file and stores in recordset. After that i created sql that stores recordset data into sql server 2005 table.
The problem is In that accno column is primary key. but i have some duplicate accno in my text file. While adding recordset to database, if it finds duplicate accno it is stopping there and not inserting any rows after that duplicate column.
Now i what i want to do is if there is any duplicate column, i want to store that column into log file and skip that column and insert remaining columns into databse. I dont know how to do it. Can anybody help me. like how to check the duplicate column and skip that and insert remaining.
' Write records to Database
frmDNELoad.lblStatus.Caption = "Loading data into database......"
Dim lngRecCount As Long
lngRecCount = 0
rcdDNE.MoveFirst
With cmdCommand
.ActiveConnection = objConn
.CommandText = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
.CommandType = adCmdText
End With
Set rcddnefrc = New ADODB.Recordset
With rcddnefrc
.ActiveConnection = objConn
.Source = "SELECT * FROM T_DATA_DNEFRC"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open
End With
Do Until rcdDNE.EOF
lngRecCount = lngRecCount + 1
frmDNELoad.lblStatus.Caption = "Adding record " & lngRecCount & " of " & rcdDNE.RecordCount & " to database."
frmDNELoad.Refresh
DoEvents
Call CommitNew
rcdDNE.MoveNext
Loop
frmDNELoad.lblStatus.Caption = "DNE Processing Complete."
frmDNELoad.Refresh
End Function
Sub CommitNew()
' Add records to DneFrc table
With rcddnefrc
.Requery
.AddNew
.Fields![RTN] = rcdDNE.Fields![RTN]
.Fields![AccountNbr] = rcdDNE.Fields![AccountNbr]
.Fields![FirstName] = rcdDNE.Fields![FirstName]
.Fields![MiddleName] = rcdDNE.Fields![MiddleName]
.Fields![LastName] = rcdDNE.Fields![LastName]
.Fields![Amount] = rcdDNE.Fields![Amount]
.Update
End With
End Sub
More of a strategy then a specific answer but ...
When importing data from external sources we'll often insert the data into staging tables that do not have the same keys/contraints placed on them and then sanitize the data prior to insertion.
What is done during "sanitation" depends on your requirements (for example, when you have two of the same account numbers are the records the same or are the data fields different, if the fields are different, how do you choose which data to use?). And then insert/move it into the production table once sanitization is complete.
I ran into this problem and what I did is to make a collection that I stored the object and the key into the Key. If I try to add a duplicated key I get an error.
This is the easyest way I found to do this in vb6. in c# is dictionary.
My suggestion would be to add error handling to CommitNew to see if the row inserted would create a primary key violation, and if so then perform other handling.
Example:
Sub CommitNew()
''#Add records to DneFrc table
On Error GoTo CommitNew_Error
With rcddnefrc
.Requery
.AddNew
.Fields![RTN] = rcdDNE.Fields![RTN]
.Fields![AccountNbr] = rcdDNE.Fields![AccountNbr]
.Fields![FirstName] = rcdDNE.Fields![FirstName]
.Fields![MiddleName] = rcdDNE.Fields![MiddleName]
.Fields![LastName] = rcdDNE.Fields![LastName]
.Fields![Amount] = rcdDNE.Fields![Amount]
.Update
End With
Exit Sub ''# If no error, exit routine.
CommitNew_Error:
If Err.Number = -2147217873 Then
''# code here will only execute if the constraint violation occurs
Call WriteDuplicateAccountToFile()
Err.Clear() ''# This clears the error, since you handled it
Else
''# Do stuff with other errors.
''# If you're not sure, at least display what error its giving, like so
MsgBox "The following error was encountered when new record was saved:" & _
vbNewLine & CStr(Err.Number) & " - " & Err.Description & vbNewLine & _
"New record not saved.", vbOkOnly + vbCritical, "Error"
End If
End Sub