I need to create a pass-through query to SQL Server. I have a functioning pass-through query which only runs from the navigation bar or query design in Access, and it only creates a single record. I have dozens of records to insert into a SQL Server table based on values in an Access table. Thus, I need to loop through the Access table in code, and for each record there create the SQL string and execute it. I've got the looping working, just need the proper code to connect to the SQL database and execute the SQL string. Here's the ODBC Connect String in the pass-through query that works, with the PW and DB starred out: "ODBC;DSN=jobboss32; UID=support; PWD=****;DATABASE=****". The code below gives a Data Type Conversion Error.
Dim strFuturePTOSource, strPassThruInsert, strEmpName, strPTODate, strUpdated As String
Dim datPTODate As Date, lngPTOHours As Long
Dim rs As New ADODB.Recordset, q As QueryDef
strFuturePTOSource = "qryROBERT" 'temporary data set to test, change to actual after working
rs.Open strFuturePTOSource, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
With rs
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
While (Not .EOF)
strEmpName = rs.Fields("EmpName")
strEmpName = "'" & strEmpName & "', "
datPTODate = rs.Fields("PTODate")
strPTODate = "'" & Format(datPTODate, "mm/dd/yyyy") & "'"
lngPTOHours = rs.Fields("PTOHrs") * 60
strUpdated = "'" & Format(Now(), "mm/dd/yyyy") & "'"
strPassThruInsert = "INSERT INTO Attendance (Attendance, Employee, Work_Date, Regular_Minutes, Attendance_Type, Lock_Times, Source, Last_Updated) VALUES (NewID(), "
strPassThruInsert = strPassThruInsert & strEmpName & strPTODate & ",lngPTOHours,2,-1,0, '" & Now() & "');"
Set q = CurrentDb.CreateQueryDef("", strPassThruInsert)
CurrentDb.QueryDefs(q).Execute
.MoveNext
Wend
End If
.Close
End With
First, you not given ANY valid reason to insert with a pass-through query.
And in fact, since EACH insert will be a 100% and separate and “discrete” insert?
Well, the time for the query processor to setup, parse the syntax, and do the insert?
Well, you not achieve ANY gains in performance, and in fact it will run no faster than a plain Jane and standard insert using DAO recodsets.
As a result:
You are knowingly as a developer wasting all kinds of time pursuing this approach and this is AFTER having been given this advice on places such as UA.
And if you knowingly are wasting developer time, and seeking an approach that costs more developer time, does not speed up your insets, then you are with full knowledge seeking an approach that costs more time, and more resources than necessary.
I suppose if you are paying for this time, and don’t care, or perhaps you are doing this as a learning exercise, then fine. But as for a working solution, the approach does not make sense, takes more code and time to develop and fix, and you are doing this will full knowledge as to the increased cost and time without any benefits I can see, or think of.
So then this begs the question?
Why would you attempt a solution will FULL knowledge that costs more time, costs more effort, and does not increase performance?
You do not given any reason as to the added benefits of this approach.
The following code is far less, far more simple, will run FASTER than your given approach. And FAR better is the date conversions that you have (are WRONG), are a non-issue.
So, you have to cook up a VERY good reason as to WHY you are perusing this course of action when:
It will not run faster than using the code I post here
(In fact, such a PT query will run slower – and by A WIDE margin).
You have errors in your date formats – you have to use ISO sql server format
(But, if you use ODBC and let the record set do the translation, then ZERO formatting and ZERO re-formatting of the date and date time values you have is NOT required).
So, until such time you explain why you are willing with full knowledge to write more code, cost more time, and cook up a solution that wastes time, and will not run faster?
Then I see little if any reason to pursue your approach?, right?
So, you need to come up with a VERY good reason as to why you are insisting on this pass-through query approach, and an approach that will run NOT run faster than what I am posting here... And in fact, as I point out, the posted solution will run MUCH faster. (Not I said a wee bit faster – but MUCH faster – in fact on a multiple order (not %, but factors of times faster). I can explain WHY this is the case (better speed) if you are wondering why.
In the meantime, you are going to have to figure out how to sleep with full knowledge of pursuing a solution that is going to cost more in developer time, and not yield any benefits in terms of speed, or even maintenance and writing of such code.
This code eliminates the date error conversions you have, and WILL RUN faster than your posted code and solution:
Dim strFuturePTOSource As String
Dim rstFrom As DAO.Recordset ' from table
Dim rstTo As DAO.Recordset ' SQL server linked table.
Set rstFrom = CurrentDb.OpenRecordset("qryROBERT", dbOpenDynaset, dbSeeChanges)
Set rstTo = CurrentDb.OpenRecordset("Attendance", dbOpenDynaset, dbSeeChanges)
Do While rstFrom.EOF = False
With rstTo
.AddNew
!Attendance = NewID()
!Employee = rstFrom!EmpName
!Work_Date = rstFrom!PTODate
!Regular_Minutes = 600
!Attendance_Type = 2
!Lock_Times = -1
!Source = 0
!Last_UPdated = Now
.Update
End With
rstFrom.MoveNext
Loop
rstTo.Close
rstFrom.Close
Edit
Given that the poster HAS made a good case that a PT query is to be used?
then this code should work:
We assume that you ALREADY created a working PT query. (and it has return records set = false). I tend to create ONE PT query in Access, and then any and all places in code can re-use that PT query at well. Also if NewID() is a scalar function (t-sql), as noted, it MUST be prefixed with dbo. So, we have to use dbo.NewID()
So, the code that is "close" or that I would suggest is this:
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strSQLS As String
strSQLS = "INSERT INTO Attendance (Attendance, Employee, Work_Date, Regular_Minutes, " & _
"Attendance_Type, Lock_Times, Source, Last_Updated) " & _
"VALUES (dbo.NewID(),"
Set rs = CurrentDb.OpenRecordset("qryROBERT")
With rs
Do While .EOF = False
strSQL = strSQLS
strSQL = strSQL & qu(!EmpName) & "," & quDate(!PTODate) & _
"," & quDate(Date) & "," & (!PTOHrs * 60) & ",2,-1,0," & quDate(Now())
With CurrentDb.QueryDefs("MyPassQuery")
.SQL = strSQL
.Execute
End With
.MoveNext
Loop
rs.Close
End With
In addtion to the above, I used two helper functions to format the date, as it is a pain to do this "in-line" code, so, I have qu() (for strings), and qudate() for dates.
Public Function qudate(myDate As Variant) As String
' returns a formatted string of date, ISO format, for sql sesrver.
' format is yyyy-mm-dd regardless of local date settings
If IsNull(myDate) = True Then
qudate = ""
Else
' use ISO date format
qudate = "'" & Format(myDate, "yyyy-mm-dd HH:NN:SS") & "'"
End If
End Function
And our qu() function
Function quS(vText As Variant) As String
' takes a string and surrounds it with single quotes
If IsNull(vText) = False Then
If InStr(vText, Chr(34)) > 0 Then
vText = Replace(CStr(vText), Chr(34), "'")
End If
End If
quS = "'" & vText & "'"
End Function
Edit 2
So, the steps are:
From sql studio, get a example working that inserts data. Once you have a working insert command, then take that same (and known) working command and cut + paste it into an access query - but just ensure that the query on the Access side is created and set as pass-though. Once again, test running this PT query. If the existing sql worked in SSMS, then it will work in Access 100% exactly with the SAME query. Once that is working?
so, whatever name you gave this query is what you use in place of MyPassQuery. You can give it any name you want, but you have to use the correct (same) name in your VBA code that going to use/set the sql for that PT query. So, each loop run will in fact overwrite what is in the query, and then you do the .Execute to run it.
Well, then you run your code. And on this line for testing?
.SQL = strSQL
Do this:
debug.print strSQL
.SQL = strSQL
So, as you single step though that code, the sql the VBA is creating will have to match the known working sql you had. So, if the string output has any syntax errors or does not look 100% the same as that known working sql? Well, then you have to tweak the VBA code until such time it spits out the SAME sql string that you know works.
I have a VBA script in MS Access that inserts a new record into a SQL Server table based on some inputs on the form.
Private Sub Allocate_Click()
Dim strSQL As String
strSQL = "INSERT INTO dbo_ALLOCATIONS " _
& "([Employee No],[Device Serial Number],[Start Date]) VALUES " _
& "('" & Me.EmployeeNumber & "', '" & Me.SerialNumber & "', '" & Me.StartDate & "')"
CurrentDb.Execute strSQL, dbFailOnError
Dim ReceiptNo As dao.Recordset
Set ReceiptNo = CurrentDb.OpenRecordset("select ##identity")
MsgBox "Device Successfully Allocated. Receipt ID is " & CurrentDb.OpenRecordset("select ##identity")
End Sub
At the end, I query the ID that was auto-incremented during the insert. I want to then quote this in a Message Box so the user can make use of it elsewhere. How can I get it to quote like that in the MsgBox command? The one I have at the moment causes lots of issues around the fact I can't combine this command, and when using only 'ReceiptNo' it says it's not a string.
There should only ever be a single result in the recordset. Try changing your last line to:
MsgBox "Device Successfully Allocated. Receipt ID is " & ReceiptNo(0)
It is not possible to print an entire recordset. You need to refer to the column that you want to print and loop through the recordset while the end of file is not reached. Then output your column as string. I did not test it though.
While not ReceiptNo.EOF
Msgbox Str(ReceiptNo!Identity)
ReceiptNo.moveNext
Wend
I have created a macro/some VBA to UPDATE a SQL Server table which works fine.
In short the code pulls a defined amount of records from the the table to excel and then the end user updates some specific information and then clicks update. A connection is created to the table and an SQL update statement runs which updates the relevant records.
The problem is where the user has not had to update a NULL field (NULL is in the SQL Server table but shows as 'empty' in Excel), when the use clicks update the SQL statement is forcing the NULL to an 'empty' entry.
To get round this I would like my code in the For Each statement to check if the cell/record is NULL or Empty and to skip to the NEXT row so the SQL Execute command is not carried out.
Here is the VBA in question:
cnn.Open cnnstr
Dim row As Range
For Each row In [tbl_data].Rows
uSQL = "UPDATE BREACH_DATA SET [VAL_BREACH_REASON] = '" & (row.Columns(row.ListObject.ListColumns("VAL_BREACH_REASON").Index).Value) _
& "' ,[VAL_BREACH_DETAIL] = '" & (row.Columns(row.ListObject.ListColumns("VAL_BREACH_DETAIL").Index).Value) _
& "' ,[VAL_VALID] = '" & (row.Columns(row.ListObject.ListColumns("VAL_VALID").Index).Value) _
& "' ,[VAL_NOTES] = '" & (row.Columns(row.ListObject.ListColumns("VAL_NOTES").Index).Value) _
& "' WHERE [ATD_NUMBER] = '" & (row.Columns(row.ListObject.ListColumns("ATD_NUMBER").Index).Value) & "'"
'Debug.Print uSQL
cnn.Execute uSQL
Next
cnn.Close
Set cnn = Nothing
Any suggestions
Kind Regards
Dino
You are updating SQL Server data directly with strings from a cell. This is a classic example of opening a door for injection attacks - users can do all kinds of bad, bad things to your database. But given that you fix that here is a way to check that each cell is not empty or null (I assume if one of the fields are not empty or null you want to update...):
if not
(
(isempty(row.Columns(row.ListObject.ListColumns("VAL_BREACH_REASON").Index).Value)
and isnull(row.Columns(row.ListObject.ListColumns("VAL_BREACH_REASON").Index).Value)
and do same for the other cell values....
)
then update....
I am working writing out reports from our company database using VBA and MS Access 2010. I have almost 3000 employees and I need to write out 10 different reports for each employee and then combine those 10 reports into one pdf per employee. These files are then saved in directories that are sorted by their duty station.
The code I have written works great and does the job intended to do EXCEPT after writing out 1024 reports I receive an error. Err.Number 3014, Cannot open anymore tables.
According to what I could find on the internet this has to do with the Jet table references and is tricky to troubleshoot. I have followed what advice I could find I believe I have properly closed out everything after use. I thought maybe the problem arose in the merge pdf files routine but even if you comment that out it still fails at 1024 reports.
I would like this code to be able to process about 30,000 reports without failing. Any ideas or thoughts would be appreciated.
Public Function combined_report(EmployeeSelectionQuery As String)
Dim DefaultPdfDir As String ' contains path to where pdf files will be written on local computer
Dim rst As Recordset ' recordset object for set of selected plots from query:Employees_COMBINED
Dim n_employees As Integer ' Number of employees selected by query:Employees_COMBINED
Dim current_employee_number As Variant ' current employee number, used when writing combined reports
Dim current_duty_station As Variant ' current duty station, used when writing combined reports
Dim strWhere As String ' String containing the where clause for the combined openreport WhereCondition
Dim arrayReport(0 To 9) As Variant ' Array containing all the reports to be processed in combined
Dim strReport As Variant ' String containing prefix to reports
Dim tempOutputPdfFile As String ' Individual report before they are combined
Dim combinedOutputPdfFile As String ' Combined report composed of individual reports REQUIRES that adobe acrobat - full version be installed.
Dim intCounter As Integer ' A iteration counter used to update the status bar
Dim combOutputPdfFile As String ' Combined Output Pdf File Path
On Error GoTo error_handler
Set rst = CurrentDb.OpenRecordset(EmployeeSelectionQuery)
'Force Access to accurately update .RecordCount property
rst.MoveLast
rst.MoveFirst
n_employees = rst.RecordCount
If n_employees = 0 Then
Call MsgBox("No employees selected by query: " & EmployeeSelectionQuery, vbCritical + vbOKOnly + vbDefaultButton1, "No Employees Selected")
combined_report = False
Else
DoCmd.Hourglass True
'Set HomeDir and create output folder
DefaultPdfDir = "C:\temp"
MakeDir DefaultPdfDir
arrayReport(0) = "REPORT_1"
arrayReport(1) = "REPORT_2"
arrayReport(2) = "REPORT_3"
arrayReport(3) = "REPORT_4"
arrayReport(4) = "REPORT_5"
arrayReport(5) = "REPORT_6"
arrayReport(6) = "REPORT_7"
arrayReport(7) = "REPORT_8"
arrayReport(8) = "REPORT_9"
arrayReport(9) = "REPORT_10"
'Set counter to zero
intCounter = 0
Do While (Not (rst.EOF))
'Get employee number and duty station to name the files and sort by directory
current_employee_number = rst!EN
current_duty_station = rst!DUTY_STATION
'Make the output directory if it doesn't exist and specify the output file path
MakeDir "C:\Final\" & current_duty_station
combOutputPdfFile = "C:Final\" & current_duty_station & "\" & current_employee_number & ".pdf"
'Increment counter by one for each employee processed
intCounter = intCounter + 1
'Where statement used by DoCmd.OpenReport to run the report for one employee only
strWhere = "[EN] = " & current_employee_number & " OR [en] = " & current_employee_number
'Process each report
For Each strReport In arrayReport
'Specify the file path and name for the report
tempOutputPdfFile = DefaultPdfDir & "\" & current_employee_number & "_" & strReport & ".pdf"
'Update Status Bar
Status ("Processing " & intCounter & " of " & n_employees & ": " & tempOutputPdfFile)
'Open the report and write it to a pdf file
DoCmd.OpenReport strReport, acViewPreview, "", strWhere, acHidden
DoCmd.OutputTo acOutputReport, strReport, acFormatPDF, tempOutputPdfFile, False
DoCmd.Close acReport, strReport, acSaveNo
'Merge the files
MergePdfFiles combOutputPdfFile, tempOutputPdfFile, combOutputPdfFile
Next strReport
'Delete the last temp file before moving on to the next employee
DeleteFile tempOutputPdfFile
rst.MoveNext
Loop
'Close everything up
Status ("")
rst.Close
Set rst = Nothing
DoCmd.Hourglass False
combined_report = True
End If
Exit Function
error_handler:
MsgBox "Error: " & Err.Number & vbNewLine & _
"Description: " & Err.Description, vbCritical, "combined_report function error"
DoCmd.Hourglass False
combined_report = False
Status ("")
End Function
Try commenting out the "DoCmd.OutputTo" statement, see if it errors. I am guessing this command is opening a report in addition to the report being opened in the prior DoCmd.OpenReport line.
(I would have just added this as a comment, but SO wouldn't let me)
I was using DoCmd.OpenReport because it had the WHERE clause functionality built in. After reading JayRO-GreyBeard's comment I realized that it did seem redundant to use both the OpenReport and OutputTo methods. So, I rewrote the code, removing the OpenReport call and modified the QueryDef for each report prior to calling OutputTo.
For some reason this worked around the problem.
Thanks for the help!
I had the same issue with the 3014 Error. I was outputting the report to PDF, while displaying the report on the screen for the user (using both Docmd.OpenReport and Docmd.OutputTo, which worked fine for single reports. However, when I would batch run reports and export/display the reports. (The tool auto generates Purchase Orders) The 3014 error would occur around 100 or so reports.
When I turned off the DoCmd.OpenReport for the batch run of reports to PDF. The 3014 error went away. I have retested, and can not run report batches in the 1000s with no problem.
I ran the SQL Server Migration Assistance to migrate only my backend tables from an Access 2003 database to SQL Server 2008 Express. Now when I connect to SQL Server via ODBC all of my tables are named like "dbo.tablename". All of my existing queries and forms do not use these names. What is the best way to resolve this problem?
Do I need to change the schema name? What SQL statement(s) would I use to take care of this problem?
I did two different things to resolve the problem detailed in the question above. First I created a routine to rename the tables. Later I decided to abandon this and I wrote a different routine (listed below) to handle the linking of my tables when the database starts up.
Public Sub subChangeLinkedTableNames()
Dim dbCurr As DAO.Database
Dim tdfCurr As DAO.TableDef
Set dbCurr = CurrentDb()
For Each tdfCurr In dbCurr.TableDefs
If Len(tdfCurr.Connect) > 0 Then
If Left(tdfCurr.Name, 4) = "dbo_" Then
tdfCurr.Name = Replace(tdfCurr.Name, "dbo_", "")
End If
End If
Next
Set tdfCurr = Nothing
Set dbCurr = Nothing
End Sub
The above code worked fine but eventually I decided to write a routine to automate relinking the tables every time I open my Access database. This routine iterates through a list of tables to be linked and for each one, it calls this sub. Notice that I'm resolving the table naming problem by specifying what name I want the table to have in the variable/argument called sLocalTableName:
Private Sub LinkODBCTable(sSourceTableName As String, sLocalTableName As String, sIndexFields As String, sConString As String)
Dim dbCurrent As DAO.Database
Dim tdfCurrent As DAO.TableDef
Set dbCurrent = DBEngine.Workspaces(0).Databases(0)
On Error Resume Next
'Let's not accidentally delete a local table of the same name
If Len(dbCurrent.TableDefs(sLocalTableName).Connect) > 0 Then
dbCurrent.TableDefs.Delete sLocalTableName
End If
Select Case Err.Number
Case 0
'Do Nothing
Case Else
Err.Clear
'Case 3011
'Table does not exist
End Select
Set tdfCurrent = dbCurrent.CreateTableDef(sLocalTableName)
tdfCurrent.Connect = sConString
tdfCurrent.SourceTableName = sSourceTableName
dbCurrent.TableDefs.Append tdfCurrent
If Err.Number <> 0 Then
'Sometimes 3010 occurs here and I don't know why. A compact and repair always seems to fix it.
MsgBox "Error in LinkODBCTable" & vbCrLf & vbCrLf & Err.Number & " " & Err.description
Err.Clear
End If
If sIndexFields <> "" Then
'sIndexFields should be field names, each enclosed in brackets, comma separated
'Most of the time it will just be one field
'This is to tell Access which field(s) is the Primary Key
dbCurrent.Execute "CREATE INDEX __UniqueIndex ON [" & sLocalTableName & "] (" & sIndexFields & ")", dbFailOnError
If Err.Number <> 0 Then
If Err.Number = 3283 Then
'Primary Key Already Exists
Else
MsgBox "Error in LinkODBCTable" & vbCrLf & vbCrLf & Err.Number & " " & Err.description
End If
Err.Clear
End If
End If
Set tdfCurrent = Nothing
Set dbCurrent = Nothing
End Sub