I have a table with a column contain email addresses.
I would like to get these email addresses and send mail to them.
My problem is that i don't know how to get the addresses.
I would like to get a string as
me#email.com;me2#email.com;me3#email.com...etc
How can i get this string in order to pass it to the recipents?
From memory (not tested):
Dim db As DAO.Database, rs As DAO.Recordset
Dim s As String
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT email FROM myTable WHERE ...")
Do While Not rs.EOF
If s = "" Then
s = rs!email
Else
s = s & ";" & rs!email
End If
rs.MoveNext
Loop
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
Since concatenating strings from a query is a frequent task, I suggest creating a reusable Function:
Public Function ConcatenateFromSql(ByVal sql As String, _
Optional ByVal delimiter As String = ";") As String
Dim db As DAO.Database, rs As DAO.Recordset
Dim s As String
Set db = CurrentDb
Set rs = db.OpenRecordset(sql)
Do While Not rs.EOF
If s = "" Then
s = rs(0)
Else
s = s & delimiter & rs(0)
End If
rs.MoveNext
Loop
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
ConcatenateFromSql = s
End Function
Related
I am using the below code to track changes on a form and it works fine.
However, I am trying to use it on my main form to record just the date/time that someone clicks a button However I get the following error:
You entered an expression that has no value
The debug takes me to this:
rs!PriorInfo = Screen.ActiveControl.OldValue
My code
Function TrackChanges()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strCtl As String
Dim strReason As String
' strReason = InputBox("Reason For Changes")
strCtl = Screen.ActiveControl.Name
strSQL = "SELECT Audit.* FROM Audit;"
Set db = CurrentDb()
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If rs.RecordCount > 0 Then rs.MoveLast
With rs
.AddNew
rs!FormName = Screen.ActiveForm
rs!ControlName = strCtl
rs!DateChanged = Date
rs!TimeChanged = Time()
rs!PriorInfo = Screen.ActiveControl.OldValue
rs!NewInfo = Screen.ActiveControl.Value
rs!CurrentUser = fOSUserName
' rs!Reason = strReason
.Update
End With
Set db = Nothing
Set rs = Nothing
End Function
I assume I need to tell it to accept null values but unsure how?
Nz(Screen.ActiveControl.OldValue) will return an empty string instead of a null value.
Nz(Screen.ActiveControl.OldValue,"<Null>") if PriorInfo is text and you want to record it was null.
Nz(Screen.ActiveControl.OldValue,-1) if PriorInfo is numeric and -1 is a safe "null" number.
I am running some code to split a slash-separated field into multiple rows, but the first value in the series is not carrying over. Does anyone know what I'm missing. Also, Rows that only have one record are not carrying over.
Public Sub ReformatTable()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsADD As DAO.Recordset
Dim strSQL As String
Dim strMPG, strBusinessName, strCustomerNumber, strCustomerName, strCountStartDate, strCCStatus As String
Dim strSplitMPG As String
Dim varData As Variant
Dim i As Integer
Set db = CurrentDb
' Select all eligible fields (have a comma) and unprocessed (SPLIT_MPG is Null)
strSQL = "SELECT BUSINESS_NAME, CUSTOMER_NUMBER, CUSTOMER_NAME, COUNT_START_DATE, CC_STATUS, MPG, SPLIT_MPG FROM [tmStarCycleCountStatuses_SlashesforCommas] WHERE ([MPG] Like ""*/*"") AND ([SPLIT_MPG] Is Null)"
Set rsADD = db.OpenRecordset("tmStarCycleCountStatuses_SlashesforCommas", dbOpenDynaset, dbAppendOnly)
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
With rs
While Not .EOF
strMPG = !MPG
strBusinessName = !BUSINESS_NAME
strCustomerNumber = !CUSTOMER_NUMBER
strCustomerName = !CUSTOMER_NAME
strCountStartDate = !COUNT_START_DATE
strCCStatus = !CC_STATUS
varData = Split(strMPG, "/") ' Get all comma delimited fields
' Update First Record
.Edit
!SPLIT_MPG = Trim(varData(0)) ' remove spaces before writing new fields
.Update
' Add records with same first field
' and new fields for remaining data at end of string
For i = 1 To UBound(varData)
With rsADD
.AddNew
!MPG = strMPG
!SPLIT_MPG = Trim(varData(i)) ' remove spaces before writing new fields
!BUSINESS_NAME = strBusinessName
!CUSTOMER_NUMBER = strCustomerNumber
!CUSTOMER_NAME = strCustomerName
!COUNT_START_DATE = strCountStartDate
!CC_STATUS = strCCStatus
.Update
End With
Next
.MoveNext
Wend
.Close
rsADD.Close
End With
Set rsADD = Nothing
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
I can't post images yet due to reputation constrictions, but here are some links.
Here's the multiple after the code:
https://s9.postimg.org/fn3u70b5b/Multiple.jpg
Here's the single records after code run:
https://s10.postimg.org/bfq9z4snt/Singles.jpg
I feel like there's something super simple that I'm missing here, but it looks like I'm already taking the MPG over, so i'm curious as to why I'm not getting the singles or the first of the series. Any help would be appreciated! Thank you.
It looks right to me, except that you have to declare like this:
Dim strMPG As String
Dim strBusinessNames As String
Dim strCustomerNumbers As String
Dim strCustomerNames As String
Dim strCountStartDates As String
Dim strCCStatus As String
I guess you will have to insert some lines with Debug.Print .. to narrow down the happenings.
Got it. Ended up changing my approach. This code will work. The pattern, regardless of length, would always be the same, so I used a Right/Left combo and integers
Public Sub ReformatmStarCycleCountStatusesTable()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strMPG As String
Dim strBusinessName As String
Dim strCustomerNumber As String
Dim strCustomerName As String
Dim dteCountStartDate As Date
Dim strCCStatus As String
Dim strSplitMPG As String
Dim intRemainingLength As Integer
Dim intInitialLength As Integer
Dim intStartPoint As Integer
Dim varData As Variant
Set db = CurrentDb
DoCmd.SetWarnings False
' Select all eligible fields (have a comma)
strSQL = "SELECT * FROM [mStar Cycle Count Statuses] WHERE [PRODUCT_FILTER_VALUE] is not null"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
With rs
While Not .EOF
strMPG = !PRODUCT_FILTER_VALUE
strBusinessName = !BUSINESS_NAME
strCustomerNumber = !CUSTOMER_NUMBER
dteCountStartDate = !COUNT_START_DATE
strCCStatus = !Status
intInitialLength = Len(strMPG)
intRemainingLength = intInitialLength
intStartPoint = 2
Do While intRemainingLength > 0
strSQL = "INSERT INTO tmStarCycleCountStatuses VALUES ('" & strBusinessName & "', '" & strCustomerNumber _
& "', #" & dteCountStartDate & "#, '" & strCCStatus & "', '" & Right(Left(strMPG, intStartPoint), 2) & "')"
DoCmd.RunSQL (strSQL)
intStartPoint = intStartPoint + 3
intRemainingLength = intRemainingLength - 3
Loop
intStartPoint = 1
.MoveNext
Wend
.Close
End With
DoCmd.SetWarnings True
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
I have a module with a procedure inside that looks like this:
Public Sub OpenRecordset()
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("QOff2")
qdf.Parameters(0).Value = [Forms]![Form]![Text10]
Dim db As Database
Dim rs As Recordset
Dim StrBusinesses As String
Set rs = qdf.OpenRecordset
If rs.EOF And rs.BOF Then
MsgBox ("No businesses exist for this Customer")
Exit Sub
Else
rs.MoveFirst
End If
StrBusinesses = ""
Do While Not rs.EOF
StrBusinesses = StrBusinesses & rs!Fnam & ", "
rs.MoveNext
Loop
rs.Close
StrBusinesses = Left(StrBusinesses, Len(StrBusinesses) - 2)
Forms!Form.Badge = StrBusinesses
Set rs = Nothing
End Sub
I am trying to get this module to input the query results into a textbox (forms!form.badge), but I can't seem to get it to do it like my 5 other dlookup functions. When I open up the module and push the green play button, it shows up on the correct textbox but also shows up on the other records as well. It also doesn't show up automatically, nor does it update as you enter in the parameters. Isn't a module supposed to help autofil numerous variables into a text box in place of dlookup for multiple values?
No. If Forms!Form!Badge is an unbound textbox, a value assigned to it will be shown identically for all records.
To individualize, you will need a lookup function which takes the ID or other unique value of the record as parameter(add to textbox):
=LookupBadges([Forms]![Form]![Text10])
Public Function LookupBadges(ByVal Value As Variant) As Variant
Dim db As Database
Dim qd As QueryDef
Dim rs As Recordset
Dim Businesses As String
Set db = CurrentDb
Set qd = db.QueryDefs("QOff2")
qd.Parameters(0).Value = Nz(Value)
Set rs = qd.OpenRecordset
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
Businesses = Businesses & rs!Fnam.Value & ", "
rs.MoveNext
Loop
End If
rs.Close
Businesses = Left(Businesses, Len(Businesses) - 2)
LookupBadges = Businesses
Set rs = Nothing
Set qd = Nothing
Set db = Nothing
End Function
I'm trying to open a record set using a SQL string. I get run time error 3061 "Too Few Parameters." any help would be appreciated.
Dim stAppName As String
Dim stURL As String
Dim rst As Recordset
Dim dbs As Database
Dim stringToSearch As Integer
Dim strSQL As String
Set dbs = CurrentDb
stringToSearch = InputBox("What is your route #?", "Enter route #: ")
strSQL = "SELECT ESRP.* FROM ESRP WHERE ESRP.Route=stringToSearch"
Set rst = dbs.OpenRecordset(strSQL)
Please change the code line of strSQL as follows, as suggested by Fionnuala you need to use variable outside the quotes.
Assuming Route field is Text data type, we need to put single quote for strings, if its number no single quote, for dates put # instead of single quote
strSQL = "SELECT ESRP.* FROM ESRP WHERE ESRP.Route='" & stringToSearch & "'"
It's a little sample, maybe it can help you
Public Function fn_SQL_dbOpenRecordset(Optional vsql As String = "") As Recordset
Dim dbs As DAO.Database
Dim rs As Recordset
On Error GoTo END_CODE
'Set the database
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset(vsql, dbOpenForwardOnly) 'you can use: dbOpenDynamic; dbOpenSnapshot; dbOpenTable
Set fn_SQL_dbOpenRecordset = rs
Exit Function
END_CODE:
Set fn_SQL_dbOpenRecordset = Nothing
End Function
Public Sub Program_Test()
On Error GoTo ERROR_SUB
Dim rs As Recordset
Dim sName As String
sName = "Joe"
sName = "'" & sName & "'" 'WARNING: BE CAREFUL WITH SQL INJECTION !!! Google it
Set rs = fn_SQL_dbOpenRecordset("select * from table1 d where PersonName = " & sName)
Dim i As Long
i = 0
While Not rs.EOF
Debug.Print rs(0).Value & " - " & rs(1).Value
rs.MoveNext
Wend
ERROR_SUB:
On Error Resume Next
If Not rs Is Nothing Then rs.Close
Set rs = Nothing
End Sub
The following code executes a stored procedure pass through query. The paramter is received fromthe form and is passed to the stored procedure. The error says that it is an invalid SQL Statement. I need to know if the code is right and how you connect to the database. The results are returned in a record set. Thanks!
Private Sub Command10_Click()
Dim rs1 As DAO.Recordset
Dim DB As Database
Dim Q As QueryDef
Dim strSQL As String
Set DB = CurrentDb()
Set Q = DB.QueryDefs("Call_SP")
strSQL = "execute dbo.ix_spc_planogram_match " & [Forms]![start]![Selection]![cat_code]
Q.ReturnsRecords = True
Q.SQL = strSQL
Set rs1 = DB.OpenRecordset(strSQL)
Do While Not rs1.EOF
Debug.Print rs1.Fields.Item("POG_DBKEY").Value = "POG_DBKEY"
Debug.Print rs1.Fields.Item("COMP_POG_DBKEY").Value = "COMP_POG_DBKEY"
Debug.Print rs1.Fields.Item("CURR_SKU_CNT").Value = "CURR_SKU_CNT"
Debug.Print rs1.Fields.Item("COMP_SKU_CNT").Value = "COMP_SKU_CNT"
Debug.Print rs1.Fields.Item("SKU_TOTAL").Value = "SKU_TOTAL"
Debug.Print rs1.Fields.Item("MATCHD").Value = "MATCHD"
rs1.MoveNext
Loop
rs1.Close
Set rs1 = Nothing
Set rs1 = Nothing
End Sub
CurrentDB is MS Access, but you are executing an SQL Server stored procedure. You need to execute against a connection to the server.
For example:
Dim objcon As New ADODB.Connection
scn = "Provider=sqloledb;Data Source=ServerName;" _
& "Initial Catalog=DBNAME;User Id=USERNAME;Password=Password;"
objcon.Open scn
Set rs = objcon.Execute