I am super new at this and need help. I am trying to send a query as an excel document to specific people contained in a table called "tblRelationship", the email is in a field called "Email". However, there are more people in this table then I want to send to. There is a third field called "RelationshipType" that I need to set to = Accounting
I have been using this code that I found:
Const stDocName As String = "qryPOAccountingReport"
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim stRecipients As String
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblRelationship")
With rs
Do While Not .EOF
stRecipients = stRecipients & ";" & !Email
.MoveNext
Loop
.Close
End With
If Len(stRecipients) > 0 Then
' discard leading ";"
stRecipients = Mid(stRecipients, 2)
DoCmd.SendObject acQuery, stDocName, acFormatXLS, _
stRecipients, , , "Thank You for your purchase"
Else
MsgBox "No recipients to email!"
End If
Set rs = Nothing
Set db = Nothing
And it works great. I just don't understand how to put the "RelationshipType" criteria in there. Can anyone help?
Thank you in advance!
Simply, run a query in your OpenRecrdset() which can take whole tables, stored queries, or SQL Select statements:
Set rs = db.OpenRecordset("SELECT [Email] FROM tblRelationship" _
& " WHERE RelationshipType='Accounting'")
Related
I'm looking for a little help/input on how to have a field auto-populate after an identification number is entered in a new record.
I have an entry screen ("RetailEntry") where someone will enter a "Pack Number" once they either move to another record I'd like the "Description" field to populate with the corresponding "Description" ("qryDescriptions") for that pack number.
Example:
If I enter pack number 6781234 it would give me the Description "Test"
I'm trying to figure out the best way of doing this and I thought maybe a record loop like below where it runs a query for the pack number and description then loops through the records to fill it in. It kinda works if I only enter one pack number but adding anymore pack numbers or copy and pasting multiple pack numbers it errors with a "No Current Record" which I'm guessing has to do with the order of processes. I am really hoping there is a way to do this where it will autofill vs me having to add a button to make this work.
Any thoughts, advice or help is greatly appreciated!!
Code:
Private Sub Form_AfterInsert()
Dim db As Dao.Database
Dim Desc As String
Dim PDesc As String
Dim rs As Dao.Recordset
Dim rq As Dao.Recordset
'Set Description
Set db = CurrentDb
Set rs = CurrentDb.OpenRecordset("RetailEntry")
Set rq = CurrentDb.OpenRecordset("qryDescriptions")
PDesc = rs.Fields("Pack_Number").Value
Desc = "SELECT DISTINCT PackNum, Description " _
& " FROM PIC704Current " _
& " WHERE Packnum = '" & PDesc & "'"
strSQL = Desc
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
db.QueryDefs.Delete "qryDescriptions"
Set qdfPassThrough = db.CreateQueryDef("qryDescriptions")
qdfPassThrough.Connect = "ODBC;DSN=SupplyChainMisc;Description=SupplyChainMisc;Trusted_Connection=Yes;DATABASE=SupplyChain_Misc;"
qdfPassThrough.ReturnsRecords = True
qdfPassThrough.ODBCTimeout = 180
qdfPassThrough.SQL = strSQL
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Loop version
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
rq.MoveFirst
Do Until rs.EOF = True
If rs.Fields("Description").Value <> rq.Fields("Description").Value Then
Else
Me!Description.Value = rq.Fields("Description").Value
End If
rs.MoveNext
rq.MoveNext
Loop
End If
End Sub
I'm attempting to write a function that compares the "Pack_Number" fields in two recordsets. My code works fine if they are in numerical order but if pack numbers are added out of order my code doesn't work right and won't recognize that the pack numbers exist.
My Code:
Function Validation()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsm As DAO.Recordset
Set db = CurrentDb
Set rs = CurrentDb.OpenRecordset("RetailEntry")
Set rsm = CurrentDb.OpenRecordset("MasterQuery")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Validate offers have not mailed
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
If rsm.RecordCount = 0 Or rs.Fields("Pack_Number") <> rsm.Fields("Pack_Number") Then
MsgBox ("All prefixes have mailed for Pack Number " & rs.Fields("Pack_Number") & " If you wish to submit an In-season Markdown Request " _
& "please exit the tool, and submit your request using the In-Season Markdown request file in the CID Request folder")
Exit Function
rs.MoveNext
rsm.MoveNext
Loop
End If
End Function
What I'm trying to do is just have it verify that the pack number they entered from RetailEntry is appearing in the MasterQuery if it is then pass else fail and msgbox pops up.
Any help would be greatly appreciated.
I'm in the process of moving all the Lotus sheets a company has to a SQL Server and I am using MS Access tables as an intermediary.
This code has been working fine for sheets that are not named but I've come across about 2300 or so sheets where it's named numb. There are too many files for me to manually change them all.
The error I am getting is:
Run-Time error '-2147217865(80040e37)':
The Microsoft Jet Database engine could not find the object "numb:A1..numb:A8000". Make sure the object exists and that you spell its name and the path name correctly.
Found this site but that hasn't provided the answer
I've seen different options for getting the destination right on an ADOB call ("SELECT * FROM [numb:A1..numb:A8000];" or ("SELECT * FROM [numb$:A1..numb$:A8000];") and those haven't worked.
Here is the functioning code when the sheet isn't named:
Dim rst As DAO.Recordset
Dim rs As DAO.Recordset
Dim LotusCn As Object
Dim rsLotus As Object
'Read WK3 Lotus files
repcode = rs![Code]
Directory = rs![Directory]
Directory = Directory & "NUMDATM.WK3"
Set LotusCn = CreateObject("ADODB.Connection")
Set rsLotus = CreateObject("ADODB.Recordset")
'This creates the objects for the lotus connctions
'below the connection string
LotusCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Directory & ";" & _
"Extended Properties=Lotus WK3;Persist Security Info=False"
strSQL = "SELECT * FROM [A1..A8000];" 'The SQL to pick the right sections of the lotus file. Picks the Latest Available Date
rsLotus.Open strSQL, LotusCn, adOpenStatic '<<< ***Error occurs here***
If Not (rsLotus.EOF And rsLotus.BOF) Then
FindRecordCount = rsLotus.RecordCount
rsLotus.MoveFirst
Do Until rsLotus.EOF = True
Debug.Print rsLotus.Fields(0).Value
If Len(rsLotus.Fields(0).Value) > 0 Then
rst.AddNew
rst!RegNo = rsLotus.Fields(0).Value
rst.Update
End If
rsLotus.MoveNext
Loop
End If
LotusCn.Close
strSQL = ""
Set rsLotus = Nothing
Set LotusCn = Nothing
Does anyone know how to get named spreadsheets?
I dont know exactly how in Lotus but this was in Excel
Set oRs = oConn.OpenSchema(adSchemaTables) 'get the name of the sheet in Excel
oRs.MoveFirst
With oRs
While Not .EOF
If .fields("TABLE_TYPE") = "TABLE" Then
Debug.Print .fields("TABLE_NAME")
If VBA.Len(.fields("TABLE_NAME")) = 9 Then
WSnameTBL = .fields("TABLE_NAME")
Else
End If
' WSnameTBL = VBA.Replace(WSnameTBL, "$", "", 1, , vbTextCompare)
End If
.MoveNext
Wend
End With
I have an Excel file that exports data into Word. It includes a cover page and grabs the user name ("First.Last") and changes it to "First Last" but I also need to include the user's professional title. This information is housed in an Access table. It has a field called Name and a field called Title. The Name field match exactly to User with no duplicates.
I have tried about eight different methods I've found online to grab this value from the table. The table will never happen to be open so I can't use "CurrentDB()".
I just need to be able to reach into the table in a database, grab the "title" value given that the value of the field "Name" is equal to the value of User (user name from the environment - the person using the excel file).
If it helps, I can provide examples of the different chunks of code I've used so far.
User is the username from the environment
tblPickName is the table I am trying to open
Path is the directory and file where the table is located
tblPickName has 2 fields, Name and Title
I need to grab the Title from this table and set it to my variable "Title" as long as Name equals User. Then I can export the username and title to Word along with the rest of the data.
Dim Path As String
Dim User As String
Dim Title As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
User = Environ("UserName")
User = Replace(User, ".", " ")
User = StrConv(User, vbProperCase)
Path = "Directory\Name.mdb"
Set db = DBEngine.OpenDatabase(Path)
Set rs = db.OpenRecordset("SELECT tblPickAnalyst.Title FROM tblPickAnalyst WHERE [Analyst]='" & User & "'")
Title = rs!Title
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
docWord.Bookmarks("AnalystName").Range.Text = User
docWord.Bookmarks("AnalystTitle").Range.Text = Title
Try this:
Public Sub JohnTayloristheBest()
Dim conAccess As ADODB.Connection
Set conAccess = New ADODB.Connection
Dim rdsAccess As ADODB.Recordset
Dim strTitle as String
With conAccess
.ConnectionString = "Data Source= **insert filepath here** "
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open
End With
With rdsAccess
.Open "SELECT tblPickName.Title FROM tblPickName WHERE tblPickName.Name = '" & Environ("username") & "';", conAccess
If Not .EOF And Not IsNull(.fields(0)) Then
strTitle = .fields(0)
Else
Msgbox "Error: No record in the database for " & Environ("username")
End If
.Close
End With
conAccess.Close: conAccess = Nothing
End Sub
Be sure to select the correct references by doing this: http://msdn.microsoft.com/en-us/library/windows/desktop/ms677497(v=vs.85).aspx
Also, this is my first answer ever written on this site (or any other for that matter), so be kind.
Try this:
Public Function getTitle(name As String)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = DBEngine.OpenDatabase("E:\Temp\Database.mdb")
Set rs = db.OpenRecordset("SELECT Title FROM tblPickName WHERE Name='" & name & "'")
If rs.RecordCount > 0 Then
getTitle = rs!Title
End If
rs.Close
db.Close
End Function
Ensure read access on table tblPickName (for Administrator)
Here is the final solution. Thank you to everyone who helped!
Dim Path As String
Dim User As String
Dim Title As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
User = Environ("UserName")
User = Replace(User, ".", " ")
User = StrConv(User, vbProperCase)
Path = "Directory\FileName"
Set db = DBEngine.OpenDatabase(Path)
Set rs = db.OpenRecordset("SELECT tblPickAnalyst.Title FROM tblPickAnalyst WHERE [Analyst]='" & User & "'")
Title = rs!Title
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
docWord.Bookmarks("AnalystName").Range.Text = User
docWord.Bookmarks("AnalystTitle").Range.Text = Title
We have a simple access database, and would like a button on a form to only be available to select members of staff. (The button has an event tied to it). I'd like to store the usernames of the staff allowed to click the button in a separate table.
What I'd like to do, is perform a simple query to see if the username exists in the table, and set the enabled state of the button depending upon the outcome.
My background is C# and SQL Server, but VBA and access are new to me, and I think I'm struggling with the quirks of this environment.
I've got the username of the logged on user in a string fOSUserName via a call to GetUserNameA in advapi32.dll, but I'm struggling with the simplest of queries to determine if the username exists in the table.
Dim strSQL As String
Dim intResult As Integer
Dim db As DAO.Database
Dim rs As Recordset
Set db = CurrentDb
strSQL = "SELECT COUNT(*) FROM [USERS] WHERE [USERS].[NAME] = '" & _
fOSUsername & "'"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not rs.EOF Then
intResult = rs.Fields(0)
Else
intResult = 0
End If
rs.Close
db.Close
This fails on db.OpenRecordset giving me the error
Run-time error '3061':
Too few parameters. Expected 1.
Can anyone offer some pointers?
When you continue a line in VBA, you need a space between before the line continuation character ("_"). So instead of this:
strSQL = "SELECT COUNT(*) FROM [USERS] WHERE [USERS].[NAME] = '" &_
fOSUsername & "'"
Use this:
strSQL = "SELECT COUNT(*) FROM [USERS] WHERE [USERS].[NAME] = '" & _
fOSUsername & "'"
However, as #Igor Turman pointed out, the lack of a space before the underline character should trigger a compile error. So I'm unsure what's going on but suggest you fix it anyway to avoid confusion.
I'll suggest that rather than opening a recordset, and then reading a value from that recordset, this could be handled simply with the DCount() function.
Dim strCriteria As String
strCriteria = "[USERS].[NAME] = '" & fOSUsername & "'"
Debug.Print "strCriteria: '" & strCriteria & "'"
If DCount("*", "USERS", strCriteria) = 0 Then
Debug.Print "not found"
Else
Debug.Print "found"
End IF
If your missing parameter error is because USERS is a query rather than a table, you can ask DCount() to use a table instead. Or fix the query.
Sounds like your [USERS] object is not a table but Query (with parameter). Also, if you had a syntax error like '&_'(invalid) as opposed to '& _'(valid), your database would not compile. So, if table vs query is your case, please use the following:
...
Dim rs As Recordset
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("Users")
qdf.Parameters("UserNameParameter") = fOSUsername
Set rs = qdf.OpenRecordset
...
I'm not totally familiar with the way you are using it, but I've always done it this way:
Dim sSQL As String
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=[your access db file path and name];Persist Security Info=False"
sSQL = "SELECT COUNT(*) FROM [USERS] WHERE [USERS].[NAME] = '" &_
fOSUsername & "'"
Set rs = New ADODB.Recordset
rs.Open sSQL, cn
If Not rs.EOF Then
intResult = rs.Fields(0)
Else
intResult = 0
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing