I have a database which stores customer job data. This data is also used to print certificates for the customer via export to an existing word document. The database is quite old and works fine on office 2003. Upon upgrading to latest office 365 I now have an issue whereby after I export the data to Word, I cannot close Word without Access also closing. I then have to re-open Access to continue using the database. Hoping somebody knows how to stop this happening.
The data is exported to Word at the click of a button in a form and the VBA code it runs is listed below. (I did not create the code or the database)
Thanks in advance
Private Sub btnPrintCert_Click()
On Error GoTo Err_btnPrintCert_Click
Dim strSQL As String
Dim RetVal As Double
Dim txtWordPath As String
Dim txtDocPath As String
Dim txtShellCommand As String
If Me.Dirty Then
RunCommand acCmdSaveRecord
End If
' delete temporary table
DoCmd.DeleteObject acTable, "tbltemp_cert"
' build sql string
strSQL = "SELECT qryjobs.postal, qryjobs.payload, qryjobs.JobNumberFull, qryjobs.job_said, qryjobs.job_entrydate, qryjobs.job_number, qryjobs.job_description, qryjobs.job_required_by, qryjobs.job_client_ordernumber, "
strSQL = strSQL & "qryjobs.job_complete_date, qryjobs.job_completed, qryjobs.cert_owner, qryjobs.cert_address, qryjobs.cert_vehicleyear, qryjobs.cert_vehiclemake, qryjobs.cert_vehiclemodel, qryjobs.cert_chassis, "
strSQL = strSQL & "qryjobs.cert_vin, qryjobs.cert_rego, qryjobs.cert_axles, qryjobs.cert_application, qryjobs.cert_hubo, qryjobs.cert_huboserial, qryjobs.cert_readingdate, qryjobs.cert_hubo_expiry_km, "
strSQL = strSQL & "qryjobs.cert_fleetnumber, qryjobs.cert_tare, qryjobs.cert_GVM, qryjobs.cert_GCM, qryjobs.cert_period, qryjobs.cert_expires, qryjobs.cert_MTM_braked, qryjobs.cert_MTM_unbraked, "
strSQL = strSQL & "qryjobs.cert_front_axlerating, qryjobs.cert_rear_axlerating, qryjobs.cert_axle_spacings, qryjobs.cert_VSR_class, qryjobs.company, qryjobs.addr1line1, qryjobs.addr1line2, qryjobs.addr1line3, "
strSQL = strSQL & "qryjobs.addr1line4, qryjobs.addr1city, qryjobs.addr1state, qryjobs.addr1postcode, qryjobs.addr2line1, qryjobs.addr2line2, qryjobs.addr2line3, qryjobs.addr2line4, qryjobs.addr2city, qryjobs.addr2state, "
strSQL = strSQL & "qryjobs.addr2postcode, qryjobs.phone1, qryjobs.phone2, qryjobs.fax, qryjobs.identifier, qryjobs.salutation, qryjobs.contactname, qryjobs.notes, qryjobs.company_type, qryjobs.job_type_desc, "
strSQL = strSQL & "qryjobs.job_type_code, qryjobs.job_type_LTSA_appr_code, qryjobs.job_type_designcode, qryjobs.job_type_cert_text, qryjobs.job_cert_word_doc, qryjobs.job_type2_desc, qryjobs.job_type2_code, "
strSQL = strSQL & "qryjobs.job_type2_title, qryjobs.VSR_class, qryjobs.VSR_class_description, qryjobs.axle_description, qryjobs.vehicle_make, qryjobs.application_description, qryjobs.expired_now, qryjobs.cert_vertical_rating, qryjobs.vert_rating, "
strSQL = strSQL & "qryjobs.qrywelders_all.Name, qryjobs.qrywelders_all.Employer, qryjobs.qrywelders_all.[4711No], qryjobs.qrywelders_all.Positions, qryjobs.qrywelders_all.Expires "
strSQL = strSQL & "INTO tbltemp_cert FROM qryjobs WHERE [qryjobs.job_said] =" & Me!job_said & ";"
' write current record info to temp table
DoCmd.RunSQL strSQL
' open & display selected word document according to job type
' the Shell function runs an executable program and returns a
' Variant (Double) representing the program's task ID if successful,
' otherwise it returns zero.
txtWordPath = "C:\Program Files\Microsoft Office\root\Office16\Winword.exe"
txtDocPath = Me![job_cert_word_doc]
txtShellCommand = Chr(34) & txtWordPath & Chr(34) & " " & Chr(34) & txtDocPath & Chr(34)
Debug.Print "shellcommand: " & txtShellCommand
RetVal = Shell(txtShellCommand, 1)
Exit_btnPrintCert_Click:
Exit Sub
Err_btnPrintCert_Click:
MsgBox Err.Description
Resume Exit_btnPrintCert_Click
End Sub
Related
I'm trying to export the results of a dynamic SQL statement but keep getting the error 3027 "Cannot update. Database or object is read-only.". I'm using Access 2003. GetYearFromDirName(sFolder) is parsing out a year from a directory structure and using that as a calculated column in the SQL results.
Here is the code in question:
sSQL = "SELECT INDEXDB1.IFIELD1 AS TestArea, INDEXDB1.IFIELD2 AS TSID, INDEXDB1.IFIELD3 AS MapCoord, " _
& "INDEXDB1.IFIELD4 AS Community, INDEXDB1.IFIELD5 AS Address, INDEXDB1.IFIELD6 AS DocNum, " _
& "'" & GetYearFromDirName(sFolder) & "' AS Yr FROM INDEXDB1;"
'DoCmd.TransferSpreadsheet acExport, , sSQL, sFolder & "\" & BoxNum & ".csv"
'DoCmd.OutputTo acOutputQuery, "ExportRecs", acFormatXLS, sFolder & "\" & BoxNum & ".csv"
SaveToExcel sSQL, sFolder & "\" & BoxNum & ".csv"
Calls:
Public Sub SaveToExcel(strSQL As String, strFullFileName As String)
Dim strQry As String
Dim db As Database
Dim Qdf As QueryDef
On Error GoTo SaveToExcel_err
strQry = "TempQueryName"
Set db = CurrentDb
'Set Qdf = db.CreateQueryDef(strQry, strSQL)
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, strQry, strFullFileName, True
'DoCmd.DeleteObject acQuery, strQry
With db
' Create permanent QueryDef.
Set Qdf = .CreateQueryDef(strQry, strSQL)
' Open Recordset and print report.
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel3, strQry, strFullFileName, True
' Delete new QueryDef because this is a demonstration.
.QueryDefs.Delete Qdf.Name
.Close
End With
Exit Sub
SaveToExcel_err:
MsgBox Error & " " & Err & " in sub SaveToExcel. Close program and start over."
End Sub
Is there a better way to export dynamic SQL statement results? In the end, I need a CSV file.
You may open it in Excel, but CSV is a text format, so you need to use DoCmd.TransferText instead of DoCmd.TransferSpreadsheet. Manually go through the export once using the Export Data Wizard. As you do so, you'll wand to create and name a Export Specification. This will specify commas as the delimiter and double quotes as text delimiters. The name of the export spec you created is passed as the second argument to TransferText.
I'm really stuck. My coworkers and I cannot figure out why this database won't connect to "CurrentDb". Here's my code:
Dim db As Database, rs As DAO.Recordset
Dim strSQL As String, strRowSource As String
strSQL = "SELECT * FROM tbl_Documents"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
If rs.RecordCount = 0 Then
MsgBox "No Documents available!"
Exit Sub
End If
rs.MoveFirst
Do Until rs.EOF = True
strRowSource = strRowSource & rs!tbl_Documents.DocID & "," & rs!tbl_Document_Types.DocType & "," & rs!tbl_Documents.DocTypeID & "," & rs!tbl_Documents.DateReceived & "," & rs!tbl_Documents.LinkToFile & "," & rs!tbl_Documents.Comments & ";"
rs.MoveNext
Loop
Typically the error I get is "Item not found in this collection" during the Do Until loop. I put a watch on my database and recordset and it seems like neither are being set properly. I'm getting "Operation is not support for this type of object." in the connection field of the database object. Essentially, the exact same code is used for many other Access Databases that we have. Not sure why this won't play nice.
Looks to me like there are quiet a few changes that needs to be done to your code. As #OverMind has suggested, always declare the variables as they are. Specially libraries to avoid ambiguity in your code. Next, your strSQL includes only one table, but your strRowSource has another table. So your strSQL should be changed. I am not sure what the strRowSource does, but sounds to me like it is going to be a RowSource of a ListBox or ComboBox in that case, it is a bit confusing. Anyway your code should be.
Dim db As DAO.Database, rs As DAO.Recordset
Dim strSQL As String, strRowSource As String
strSQL = "SELECT * FROM tbl_Documents INNER JOIN tbl_Document_Types ON tbl_Documents.DocID = tbl_Document_Types.DocTypeID;"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
If rs.RecordCount = 0 Then
MsgBox "No Documents available!"
Exit Sub
End If
Do While Not rs.EOF
strRowSource = strRowSource & rs!DocID & "," & rs!DocType & "," & rs!DocTypeID & "," & rs!DateReceived & "," & rs!LinkToFile & "," & rs!Comments & ";"
rs.MoveNext
Loop
Now regarding your error. "Item not found in this collection" - could be because of the fact you were using the other fields which were not part of the recordset object. Try this code. Good luck. :)
I am having some problems with my Access d-Base. I will try to explain what I want to achieve:
I have a continuous form based on a query with a lot of records. Users have to scan these records and If needed send a selection of these records to the concerning customer. Therefore I have used a textbox in my form combined with the following query column:
Expr1: (IIf([Forms]![frm_POOpenOrdersPerVendor]![partnrFilter] Is Null,True,[po_partnr]=[Forms]![frm_POOpenOrdersPerVendor]![partnrFilter]))
And criteria is: <>False
This works perfect in my form. After my filter is set I want to e-mail the results in the body of my email (Outlook). To do this I use:
Option Compare Database
Public Sub Export_PO()
On Error GoTo EH
'Recordset variables
Dim db As Database
Dim rstOpenPurchaseOrders As Recordset
Dim strSQL As String
Dim strSubject As String
Dim strBody As String
Dim strAddresses As String
Set db = CurrentDb()
strSQL = "SELECT * FROM qry_POOpenOrdersPerVendor;"
Set rstOpenPurchaseOrders = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not rstOpenPurchaseOrders.EOF Then
strBody = "blah blah blah" & vbCrLf & vbCrLf
strBody = strBody & "Partnumber" & " | " & "Vendor Partnumber" & " | " & "Promise Date" & vbCrLf
strBody = strBody & "===========================================================" & vbCrLf
rstOpenPurchaseOrders.MoveFirst
Do While Not rstOpenPurchaseOrders.EOF
strBody = strBody & rstOpenPurchaseOrders![po_partnr] & Chr(9) & rstOpenPurchaseOrders![po_vendor_part] & Chr(9) & rstOpenPurchaseOrders![po_prom_date] & vbCrLf
rstOpenPurchaseOrders.MoveNext
Loop
End If
strSubject = "Here's my report!"
strAddresses = "look.look#nmhg.com"
DoCmd.SendObject acSendNoObject, , acFormatTXT, asAdresses, , , strSubject, strBody, True
Exit Sub
EH:
MsgBox Err.Number & " " & Err.Description
Exit Sub
End Sub
Separately my codes work fine (both). If I want to combine them I get the error "3061 Too few parameters. Expected 1."
Anybody?
Thanks in advance!
Your Query qry_POOpenOrdersPerVendor - required one argument to be passed either via a Form or just by prompting for a value. In VBA if you wish to use a precompiled query that expects a parameter you will bump into this error. So you need to use the main Query to be used in the VBA NOT the name of the Query.
I was asked to capture the date when a specific field is updated , so I created an event to update the record of that field.
Dim db As Database
Dim strSQL As String
Dim LDate As String
LDate = Format(Date, "yyyy-mm-dd")
Set db = CurrentDb
strSQL = "UPDATE [Lotinfo] " & _
"SET [PriorityChanged] = " & _
Chr(34) & LDate & Chr(34) & _
" where [BKPO#] = " & _
Chr(34) & Forms![LotTabFrm]![LotInfoPriority]![BKPO#] & Chr(34) & _
" and [ModelNo] = " & _
Chr(34) & Forms![LotTabFrm]![LotInfoPriority]![ModelNo] & Chr(34)
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
The update does happen, however it keeps showing a 'copy to clipboard' message box asking me to drop the changes or copy to clipboard and in both cases the changes are lost
Is there a way to stop that message box from showing up?
You are getting this message because Ms Access has a conflict. Should it save the values you entered into the form or rather the values you are entering now using the UPDATE statement?
Assuming that you want the values from the UPDATE statement, add the following line before the UPDATE to save the Form values first:
DoCmd.RunCommand acCmdSaveRecord
I have created the code below to test whether I can run a query and retrieve a data from an SQL server table. And so far I can return the result using a MessageBox, but somehow I just don't know how to use this connection to update the table inside this Access file. Basically I want to use this as a front end file. Then, when the form is open it will automatically update the table inside this access file and load the data to the combo box as a list. I tried searching it here and read many discussions here and in Google but currently I can't find the right solution.
Option Compare Database
Sub LocalServerConn_Test()
Set conn = New adodb.Connection
Set rst = New adodb.Recordset
strDBName = "DataSet"
strConnectString = "Provider = SQLOLEDB.1; Integrated Security = SSPI; " & _
"Initial Catalog = " & strDBName & "; Persist Security Info = True; " & _
"Worksation ID = abc123;"
conn.ConnectionString = strConnectString
conn.Open
strSQL = "SELECT DISTINCT dbo.abc.abc123 FROM dbo.abc"
rst.Open Source:=strSQL, ActiveConnection:=strConnectString, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic
If rst.RecordCount = 0 Then
MsgBox "No records returned"
Else
rst.MoveFirst
Do While Not rst.EOF
MsgBox rst.Fields("abc123").Value
rst.MoveNext
Loop
End If
conn.Close
rst.Close
End Sub
You should be able to use code very similar to this:
Dim cdb As DAO.Database
Set cdb = CurrentDb
cdb.Execute _
"DELETE FROM LocalTable", _
dbFailOnError
cdb.Execute _
"INSERT INTO LocalTable (abc123) " & _
"SELECT DISTINCT abc123 " & _
"FROM " & _
"[" & _
"ODBC;" & _
"Driver={SQL Server};" & _
"Server=.\SQLEXPRESS;" & _
"Database=DataSet;" & _
"Trusted_Connection=yes;" & _
"].[dbo.abc]", _
dbFailOnError
Set cdb = Nothing
You can just keep the combo box bound to [LocalTable] and the updated values from the SQL Server table should appear.