In Access 2007 I'm trying to send the results of a query however, I keep receiving the error "Run-time error '3265': Item not found in this collection." The error is coming up on the line:
Set qry = CurrentDb.QueryDefs(ReportQueryName)
I've checked spelling on the fields and I've tried messing with the Tools>References to make sure that I have the correct library.
This is my current code:
Private Sub Command202_Click()
Dim qry As DAO.QueryDef
Dim strSQL As String
Dim ReportQueryName As String
ReportQueryName = "ReportEmail"
Set qry = CurrentDb.QueryDefs(ReportQueryName)
strSQL = "SELECT [ID], [title] FROM Cases WHERE ID = " & Me.ID
qry.SQL = strSQL
DoCmd.SendObject acSendQuery, "ReportEmail", acFormatXLSX, "email#address.com", ..., , False
End Sub
You can't use QueryDefs to create a new query - you have to use CreateQueryDef instead:
Private Sub Command202_Click()
Dim qry As DAO.QueryDef
Dim strSQL As String
Dim ReportQueryName As String
ReportQueryName = "ReportEmail"
strSQL = "SELECT [ID], [title] FROM Cases WHERE ID = " & Me.ID
Set qry = CurrentDb.CreateQueryDef(ReportQueryName,strSQL)
DoCmd.SendObject acSendQuery, "ReportEmail", acFormatXLSX, _
"email#address.com", ..., , False
End Sub
Sometimes your new query will not show up in the Access windows straight away.
If you want it to, you can use:
Application.RefreshDatabaseWindow
Related
I have tried to create the event procedure, but It returns zero irrespective of my selection.
I have two tables, which are correctly joined, and below is the code that has an issue.
First, "MsgBox Me.Technology" is returning my selection value eg. Python, Java, but "MsgBox rs!ProjEmployeeID" is returning 0 all times. Help me troubleshoot the code. Thank you. I want it to return Project Employee ID like 1, 2, 3
Option Compare Database
Private Sub Technology_AfterUpdate()
MsgBox Me.Technology
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT ProjEmployeeID FROM Project WHERE Technologies = Trim('" & Forms!Form_employee_by_technologies!Technology & "')")
rs.AddNew
MsgBox rs!ProjEmployeeID
Dim strDocName As String
Dim strWhere As String
strDocName = "Technology"
strWhere = "[EmployeeID] =" & rs!ProjEmployeeID
DoCmd.OpenReport strDocName, acViewReport, , strWhere, acWindowNormal
End Sub
I am working on a project where the company still has everything in lotus notes and we're starting redesign the system so they no longer run on Lotus.
Now, I am just trying to import the Lotus tables in an MS Access Database but keep getting the error "Numeric Overflow". Does anyone know how to handle this?
The table has 196 columns and 846 rows. Currently, I have named a range in the lotus table. However, ideally we would be able to just name the range we want to import so:
"SELECT * INTO PRNTDATM FROM [a:a1..a:a8100]"
Full error:
Run-time error '-2147467259(800004005)' Numeric Field overflow
Private Sub Command0_Click()
Dim CombLoop As Integer
Dim LotusCn As Object
Dim rsLotus As Object
Dim strSql, CombFileName, GotoRange As String
Set LotusCn = CreateObject("ADODB.Connection")
Set rsLotus = CreateObject("ADODB.Recordset")
LotusCn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source= K:\GEVS04\NUMBDATM.WK3; Extended Properties=Lotus WK3;"
strSql = "Select * INTO PRNTDATM FROM phil"
rsLotus.Open strSql, LotusCn
LotusCn.Close
Set rsLotus = Nothing
Set LotusCn = Nothing
End Sub
Since this Post i have been working on it and had some improvements i can now read and import some test data to the tables. Found appending worked better than importing whole new table so will have to try that route. Doing this seems to have fixed the overflow issue because i now have the table structure itself already in place as there are only about 5 Table structures that should work fine for this code.
The code is now:
Dim CombLoop As Integer
Dim LotusCn As Object
Dim rsLotus As Object
Dim strSql As String
Dim rs As DAO.Recordset
Set LotusCn = CreateObject("ADODB.Connection")
Set rsLotus = CreateObject("ADODB.Recordset")
LotusCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Users\germany5.PLIMSOLL\Desktop\TEST.WK4;" & _
"Extended Properties=Lotus WK4;"
strSql = "SELECT * FROM [a1..C3];"
rsLotus.Open strSql, LotusCn
Set rs = CurrentDb.OpenRecordset("Select * From NICHDATMGECO20;")
If Not (rsLotus.EOF And rsLotus.BOF) Then
FindRecordCount = rsLotus.RecordCount
rsLotus.MoveFirst
Do Until rsLotus.EOF = True
Field1 = rsLotus![Reg. Number]
Field3 = rsLotus![Sales / Tot.Assets]
Field2 = rsLotus![Company Name]
rs.AddNew
rs![Reg. Number] = Field1
rs![Company Name] = Field2
rs.Update
rsLotus.MoveNext
Loop
End If
LotusCn.Close
Set rsLotus = Nothing
Set LotusCn = Nothing
rs.Close
Just to let you know the problem has been solved and above is the end result of the code which works fine for me. I did need to reference Lotus 123 in Tools just in case anyone wants to replicate what Ive done here.
In my form i want to use a sum on row SWS from tblKurse used in the query for the form. On a Button Click event i want to sum the values in that row whenever the criterion in my where is met. Problem is i get an invalid argument error whenever i run it. I just cant find my mistake. Maybe someone can help.
Heres the function that i call after the button click event:
Public Function chkSWS() As Integer
Dim db As Database
Dim rst As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT SUM(tblKurse.SWS) As Stunden " _
& "FROM tblKurse " _
& "WHERE tblKurse.Dozent_ID = " & Me.cmbKursDOzent
Debug.Print strSQL
Debug.Print Me.Dozent_ID
Set rst = db.OpenRecordset(strSQL, dbForwardOnly)
chkSWS = rst![Stunden]
Set rst = Nothing
Set db = Nothing
End Function
Error points on the "Set rst" line, so it might been a bad Select statement?
printed SQL Statement:
SELECT SUM(tblKurse.SWS) As Stunden FROM tblKurse WHERE tblKurse.Dozent_ID = 1
Change this line
Set rst = db.OpenRecordset(strSQL, dbForwardOnly)
to this
Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
I am Running Access 2016 and I am trying to get some records from a query. I am an Access noob and I am making a database.
When I run the following Code, i get Error 3075, and it says an Operator is not there, the thing is, when i paste the SQL code into an access Query it runs just fine, so I cant see the problem
Sub DOthings()
Dim i As Integer
Dim array1() As Variant
Dim array2() As Variant
Dim daDb As DAO.Database
Set daDb = CurrentDb
'' getting temp vars first
Dim vend As String
vend = CStr([TempVars]![temp1]) '' I get these TEMP vars from the access application
Dim loc As String
loc = CStr([TempVars]![temp2])
MsgBox ("Vendor is: " & vend & " And Location is: " & loc)
'setting SQL statement
Dim qry As String 'SQL STATEMENT FOR QUERY
qry = "SELECT [Table1].ScanID, [Table2].FieldV, [Table1].[FieldA], [Table1].[FieldE], (([Table1]![FieldE])/([Table1]![FieldA])) AS V, [Table1].[QR Code], [Table3].[Selected?], [Table3].[Location Recieved], [Table3].[Travel Notes] FROM ([Table2] INNER JOIN [Table1] ON [Table2].BatchID = [Table1].BatchID) INNER JOIN [Table3] ON [Table1].ScanID = [Table3].Scan_ID **WHERE ((([Table2].FieldV) = " & vend & ") And (([Table3].[Location Recieved]) = " & loc & ") And (([Table3].[Date Shipped]) Is Null)) ORDER BY (([Table1]![fieldE])/([Table1]![FieldA])) DESC;**"
Dim daQdf As DAO.QueryDef 'First Query to find and SELECT the actual datapoints."
Set daQdf = daDb.CreateQueryDef(qname, qry)
Dim daRs As DAO.Recordset 'Getting the recordset Setup
Set daRs = daQdf.OpenRecordset(qname, Dynaset)
So The error I am getting basically says my Where statement is wrong, but i cant see the problem. Is the source of the error somewhere else?
This is the Error statement i am getting:
Can Anyone Tell me how I can fix this? Or what the cause of the Problem is?
The following code runs as far as the marked line. Word then shows a file locked for editing/ open read only prompt. I need to be able to edit the document (that is the whole point of the code).
Sorry for incredibly long code block - I felt it was important to show everything so that it was easier to find the problem.
The code is also kind of clunky with the multiple recordsets, if anyone has any better ideas would love to here them.
Option Explicit
Option Compare Database
Sub InputSafetyData()
Dim dbCur As Database
Dim appCur As Word.Application
Dim docCur As Word.Document
Dim dlgCur As FileDialog
Dim rngCcCur As Range
Dim varDlgCur As Variant
Dim strDocName As String
Dim strDocPath As String
Dim strSQL As String
Dim rsIt As DAO.Recordset
Dim rsHc As DAO.Recordset
Dim rsHz As DAO.Recordset
Dim rsPr As DAO.Recordset
Dim strHc As String
Dim strHz As String
Dim strPr As String
Set dbCur = CurrentDb()
Set dlgCur = Application.FileDialog(msoFileDialogFolderPicker)
With dlgCur
.AllowMultiSelect = False
If .Show <> -1 Then End
varDlgCur = .SelectedItems(1)
End With
strDocPath = CStr(varDlgCur) & "\"
strDocName = Dir(strDocPath & "*.docx")
Set appCur = New Word.Application
appCur.Visible = True
Set dlgCur = Nothing
Do While strDocName <> ""
'Runs as far here
Set docCur = appCur.Documents.Open(FileName:=strDocPath & strDocName, ReadOnly:=False, Visible:=False)
If docCur.ReadOnly = False Then
Set rngCcCur = docCur.ContentControls(6).Range
rngCcCur = ""
appCur.ActiveDocument.Tables.Add Range:=rngCcCur, NumRows:=1, NumColumns:=4
With rngCcCur.Tables(0)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
.Style = "Light Shading"
.AutoFitBehavior wdAutoFitWindow
.Cell(1, 1).Range.InsertAfter "Item"
.Cell(1, 2).Range.InsertAfter "Hazcard"
.Cell(1, 3).Range.InsertAfter "Hazard"
.Cell(1, 4).Range.InsertAfter "Precaution"
'select distinct item based on filename
strSQL = "Select Distinct Item From IHR where filename is"
strSQL = strSQL & strDocName
Set rsIt = dbCur.OpenRecordset(strSQL, dbOpenDynaset)
If Not (rsIt.BOF And rsIt.EOF) = True Then
While Not rsIt.EOF
.Rows.Add
.Cell(rsIt.AbsolutePosition + 2, 1).Range.InsertAfter rsIt.Fields(1).Value
'select distinct hazcard based on item
strSQL = "Select Distinct Hazcard From IHR where item is"
strSQL = strSQL & rsIt.Fields(1).Value
Set rsHc = dbCur.OpenRecordset(strSQL, dbOpenDynaset)
If Not (rsHc.BOF And rsHc.EOF) = True Then
While Not rsHc.EOF
strHc = strHc & " " & rsHc.Fields(2).Value
.Cell(rsIt.AbsolutePosition + 2, 2).Range.InsertAfter strHc
rsHc.MoveNext
Wend
End If
rsHc.Close
Set rsHc = Nothing
'select distinct hazard based on item
strSQL = "Select Distinct Hazard From IHR where item is"
strSQL = strSQL & rsIt.Fields(1).Value
Set rsHz = dbCur.OpenRecordset(strSQL, dbOpenDynaset)
If Not (rsHz.BOF And rsHz.EOF) = True Then
While Not rsHz.EOF
strHc = strHz & " " & rsHz.Fields(2).Value
.Cell(rsIt.AbsolutePosition + 2, 3).Range.InsertAfter strHz
rsHz.MoveNext
Wend
End If
rsHz.Close
Set rsHz = Nothing
'select distinct precaution based on item
strSQL = "Select Distinct Precaution From IHR where item is"
strSQL = strSQL & rsIt.Fields(1).Value
Set rsPr = dbCur.OpenRecordset(strSQL, dbOpenDynaset)
If Not (rsPr.BOF And rsPr.EOF) = True Then
While Not rsPr.EOF
strPr = strPr & " " & rsPr.Fields(4).Value
.Cell(rsIt.AbsolutePosition + 2, 4).Range.InsertAfter strPr
rsPr.MoveNext
Wend
End If
rsPr.Close
Set rsPr = Nothing
rsIt.MoveNext
Wend
End If
End With
rsIt.Close
Set rsIt = Nothing
Debug.Print (docCur.Name)
docCur.Save
End If
docCur.Close
Set docCur = Nothing
strDocName = Dir
Loop
Set appCur = Nothing
End Sub
Focus on the immediate problem --- "Cannot open word file for editing".
I created a folder, C:\share\testdocs\, and added Word documents. The code sample below uses a constant for the folder name. I wanted a simple test, so got rid of FileDialog. I also discarded all the recordset code.
I used Visible:=True when opening the Word documents. I didn't understand why you have the Word application visible, but the individual documents not visible. Whatever the logic for that, I chose to make them visible so I could observe the content changes.
I tested this with Access 2007, and it works without errors. If it doesn't work for you, double-check the file system permissions for the current user for both the folder and the target documents.
Public Sub EditWordDocs()
Const cstrFolder As String = "C:\share\testdocs\"
Dim appCur As Word.Application
Dim docCur As Word.Document
Dim strDocName As String
Dim strDocPath As String
Dim strMsg As String
On Error GoTo ErrorHandler
strDocPath = cstrFolder
strDocName = Dir(strDocPath & "*.docx")
Set appCur = New Word.Application
appCur.Visible = True
Do While strDocName <> ""
Debug.Print "strDocName: " & strDocName
Set docCur = appCur.Documents.Open(FileName:=strDocPath & strDocName, _
ReadOnly:=False, Visible:=True)
Debug.Print "FullName: " & docCur.FullName
Debug.Print "ReadOnly: " & docCur.ReadOnly
' add text to the document ... '
docCur.content = docCur.content & vbCrLf & CStr(Now)
docCur.Close SaveChanges:=wdSaveChanges
Set docCur = Nothing
strDocName = Dir
Loop
ExitHere:
On Error Resume Next
appCur.Quit SaveChanges:=wdDoNotSaveChanges
Set appCur = Nothing
On Error GoTo 0
Exit Sub
ErrorHandler:
strMsg = "Error " & Err.Number & " (" & Err.Description _
& ") in procedure EditWordDocs"
MsgBox strMsg
Debug.Print strMsg
GoTo ExitHere
End Sub
Assuming you're able to get past the read-only problem, I think you have more challenges ahead. Your SELECT statements look highly suspicious to me ...
'select distinct item based on filename '
strSQL = "Select Distinct Item From IHR where filename is"
strSQL = strSQL & strDocName
For example, if strDocName contains "temp.docx", strSQL will contain this text ...
Select Distinct Item From IHR where filename istemp.docx
That is not a valid SELECT statement. I think you may need something more like this ...
SELECT DISTINCT [Item] FROM IHR WHERE filename = 'temp.docx'
Item is a reserved word, so I enclosed it in square brackets to avoid confusing the db engine. Use the equality operator (=) instead of "is" for your string comparisons.
It is extremely useful to Debug.Print your strSQL string, so that you may directly examine the completed statement you're asking the db engine to run ... view it instead of relying on your imagination to guess what it looks like. And when it fails, you can copy the Debug.Print output from the Immediate window and paste it into SQL View of a new query for testing.
However, those Access query issues don't matter until you can get past the read-only issue with your Word documents.
To follow up on the issue of visibility vs. read-only, my code opened the Word documents and modified them without throwing errors when I included either or both of these two changes:
appCur.Visible = False
and
Set docCur = appCur.Documents.Open(FileName:=strDocPath & strDocName, _
ReadOnly:=False, Visible:=False)
I had the same problem with a file opened read only. You can try putting in the following code:
appcur.ActiveWindow.View.ReadingLayout = False