I have a form with 2 subforms. One subform has a timer for 30 minutes to refresh data which runs fine. The other subform has the following code to send an email at a set time
If DLookup("SCHEDULEDATETIME", "TBLSCHEDULERNEW", "SCHEDULETYPE='AWAITREG'") >= Date Then
End
End If
If TimeValue(Now()) > #9:00:00 AM# Then
Set oApp = CreateObject("Outlook.application")
Set oMail = oApp.CreateItem(olMailItem)
oMail.Body = "email"
oMail.Subject = "Test Subject"
oMail.To = "xxx#xxx.com"
oMail.Send
Set oMail = Nothing
Set oApp = Nothing
End If
strsql = "update TBLSCHEDULERNEW set SCHEDULEDATETIME =trunc(sysdate) WHERE SCHEDULETYPE='AWAITREG';"
With MyCon
.Open "xxx", "xxx", "xxx"
.Execute strsql
.Close
End With
I have additional code to check if the email has been sent today already, which works fine
This only runs once. I have to open the form in Design View, and then Form View again for the code to start working. Why could this be?
I need to schedule the email dispatch in this way rather than SendObject as I need to attached a formatted Excel spreadsheet.
Edit - I now don't think this is anything to do with sending an email, as code just seem to be called at all - I tested with just a msgbox.
And End really means that.
Your code will stop and all variables will be cleared. Probably not what you want.
Related
I am currently working on a project were one of the requirements are to use the users windows login as their login for MS Access, where they would then click there role to gain access into the system. I have never done this before but I have set up a login screen in Access which pulls data from a table. I have code that successfully pulls the users windows login but I am having trouble after this. The table name is tblUser and the users are General User, HR, and Admin. Currently, In the table I have the roles assigned number with General User = 1, HR = 2, Admin = 3.
The Login Screen:
Log On
General User
HR
Admin
Code that pulls the user information:
Private Sub Form_Load()
Stop
Debug.Print Environ("UserName")
Debug.Print Environ$("ComputerName")
Dim strVar As String
Dim i As Long
For i = 1 To 255
strVar = Environ$(i)
If LenB(strVar) = 0& Then Exit For
Debug.Print strVar
Next
End Sub
Below is the code that I built for my login screen in the past. Through drawing everything out it seems as though it would be the same process but I am not to sure. Is there anything that I can do to the code below?
Private Sub btnLogin_Click()
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("tblUser", dbOpenSnapshot, dbReadOnly)
rs.FindFirst "UserName='" & Me.txtUserName & "'"
If rs.NoMatch = True Then
Me.lblWrongUser.Visible = True
Me.txtUserName.SetFocus
Exit Sub
End If
Me.lblWrongUser.Visible = False
If rs!Password <> Nz(Me.txtPassword, "") Then
Me.lblWrongPass.Visible = True
Me.txtPassword.SetFocus
Exit Sub
End If
Me.lblWrongPass.Visible = False
If rs!EmployeeType_ID = 3 Then
Dim prop As Property
On Error GoTo SetProperty
Set prop = CurrentDb.CreateProperty("AllowBypassKey", dbBoolean, False)
CurrentDb.Properties.Append prop
SetProperty:
If MsgBox("Would you like to turn on the bypass key?", vbYesNo, "Allow Bypass") = vbYes Then
CurrentDb.Properties("AllowBypassKey") = True
Else
CurrentDb.Properties("AllowBypassKey") = False
End If
End If
DoCmd.OpenForm "frmPersonal_Information"
DoCmd.Close acForm, Me.Name
End Sub
I hope this is enough information for what I am trying to accomplish. If anymore information is needed please let me know. Thank you.
You do not need a login screen if the roles are tied to your Windows/Active Directory logins. You should make the assumption that the logged on user in Windows is legitimately using the workstation (and if that is not a safe assumption you need to look into your IT policies).
Access does not support roles and permissions. After accessing which user is currently logged on and getting their role from tblUser will have to:
Lock down the back end and especially access to the tables.
Lock down most of the user interface inherent to Access and only allow your front end forms to be used.
For each form of your front end manually make sure that whatever policies you wish to enforce are enforced using VBA.
Ultimately no matter what you do, somebody that knows how to use Access well can bypass any kind of lockdown you put in place. If you need to guard against more than casual curiosity and honest errors, you will need to combine Access with a much more robust DBMS like SQL server or MySQL.
How can I get current Office Windows account email using VBA code?
I do not mean the account which the user is logged in the Windows, I mean the account that is authorized in office
See image:
I don't believe you can access it. Your best bet is linking Access to Outlook and trying to access it from there.
For example you Set a reference to the Outlook object library and then :-
Dim olook As Outlook.Application
Dim EAddress As String
Set olook = GetObject(, "Outlook.Application")
Set olook = CreateObject("Outlook.Application")
EAddress = olook.Session.CurrentUser.Address
I have a similar solution calling out to Outlook, I'm using Excel and found a way to do this, I've only ever found one address in the Accounts collection, but have a suffix match to try and catch the #company.com I'm looking for:
Dim NameSpace As Object
Dim strEmailAddress As String
Set NameSpace = CreateObject("Outlook.Application").GetNameSpace("MAPI")
strEmailAddress = ""
For Each Account In NameSpace.Accounts
If LCase(Split(Account.SMtpAddress, "#")(1)) = "contoso.com" Then
strEmailAddress = Account.SMtpAddress
Else
strEmailAddress = "Unknown"
End If
' If you want to see more values, uncomment these lines
'Debug.Print Account.DisplayName
'Debug.Print Account.UserName
'Debug.Print Account.SMtpAddress
'Debug.Print Account.AccountType
'Debug.Print Account.CurrentUser
Next
Outlook interrupts the VBA-execution (to access Outlook objects from macro) due to security.
Snap shot
Outlook Security
Hence only to get eMailID without opening object as well as handling error in case of non availability of outlook/account, following code can work in your case
VBA Code
Sub Email_Address()
Dim MAPI As Object
Status = "unknown"
On Error GoTo return_value
Set MAPI = CreateObject("Outlook.Application").GetNameSpace("MAPI")
i = 1
Do While True
Debug.Print MAPI.Accounts.Item(i)
i = i + 1
Loop
return_value:
If i > 1 Then: Status = "done..."
Debug.Print Status
End Sub
I'm working on a small program in which one letter in Word needs to be create when one button in a Access subform is clicked.
The form represents one client and in the subform there are the list of commands done by this client. Next each command line (containing date and description), there is one button that trigger the maccro and create the letter. Until now, I succeed to create the word letter when one button is clicked but each command in the subform create a page in the word document.
Is it possible to keep only the command next to the button clicked and not all the command?
I was looking for that kind of command :
"SELECT * FROM [Fusion]WHERE [id_client] = " & Forms!subform!id_client
but when I do it for the subform I have one error saying that the form doesn't exist...
Thanks for your help.
--EDIT--
Here is the code, the [Fusion] is my SQL request which get all the clients and the orders related to them.
Function Publipostage()
Dim mDoc As String
Dim strSQL As String
' Path of the letter
mDoc = "C:\...\LT000006.docx"
strSQL = "SELECT * FROM [Fusion]WHERE [id_client] = " & Forms!FormPatient!id_client
Dim oApp As New Word.Application
Dim oMainDoc As Word.Document
Dim sData As String
oApp.Visible = True
sData = "C:\...\Database1.accdb"
Set oMainDoc = oApp.Documents.Open(mDoc)
With oMainDoc.MailMerge
.MainDocumentType = wdFormLetters
.OpenDataSource Name:=sData, SQLStatement:=strSQL
End With
With oMainDoc
.MailMerge.Destination = wdSendToNewDocument
.MailMerge.Execute
End With
oApp.Activate
oApp.Documents.Parent.Visible = True
oApp.Application.WindowState = 1
oApp.ActiveWindow.WindowState = 1
Set oApp = Nothing
Set oMainDoc = Nothing
Exit Function
Err_Handle:
Set oApp = Nothing
Set oMainDoc = Nothing
MsgBox "An error occurred..." & vbCrLf & vbCrLf & Err.Description
End Function
your question is a bit unclear but if the button is on the subform you can use
Me.id_client
if it is on the main form try
Forms("MAIN FORM NAME").Controls("SUB FORM NAME").Form.Controls("id_client")
Edit
Or Me.Parent.Controls("id_client")
When referencing a subform you must reference the parent form first.
If you only want to print 1 command from the list then it seems your SQL needs to change to reference that command. i.e.
"SELECT * FROM [Fusion] WHERE [id_command] = " & Me.id_command
This is just an example as I am unaware of your table structure.
I needed to make it in access so that I send an email to a certain customer when their date of birth is within 3 days.
Dim rs as dao.recordset
set rs = currentdb.openrecordset(“DiscountEmail”)
with rs
if .eof and .bof then (No Records found for this query.)
Msgbox “ No emails will be sent because there are no records from the query ‘DiscountEmail’ “
else
do until .eof
DoCmd.SendObject acSendNoObject, , , ![Email Address Field], , , “Happy Birthday!”, “Hello ” & ![First Name Field] & _
“, ” & Chr(10) & “Come in on your birthday and receive a 10% discount!”, False
.edit
![Email_Sent_Date] = now()
.update
.movenext
loop
End If
end with
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
I have this code, but now I just need to make it so that if a certain customer's birthday (In my table 'CustomerInfo') is within 3 days, it sends them an email saying that they can come in on their birthday and receive a discount.
Also, I want to make it so that this happens automatically (so I don't have to press any button), but so that it sends it only once, and so I can send it again next year.
Thanks in advance! :)
You need to have some event in order to fire this event. An Access database is just a file, so when you're not using it, it's not running any code.
Doing a simple check every time the database is opened, maybe on the first form's On Load event would be the way to go. I assume your DiscountEmail RecordSet is the one querying for emails within the 3 day period.
Your solution is to either put this in the onLoad event for your first form or to use another service. As far as not spamming the emailee more than once, just add a emailSent field or log sent emails to a different table, and handle it after the email is sent.
Example query to find the relevant emails:
Select email from Users Where dateOfBirth between dateAdd("d",-3,Date()) AND dateAdd("d",3,Date());
Do send an email, you could use SMTP and CDO. Create an email function called something like sendEmail
Public Sub SendEmail(strTo as STring, strFrom as String, strSubj as String, strBody as String)
Dim imsg As Object
Dim iconf As Object
Dim flds As Object
Dim schema As String
Set imsg = CreateObject("CDO.Message")
Set iconf = CreateObject("CDO.Configuration")
Set flds = iconf.Fields
' send one copy with SMTP server (with autentication)
schema = "http://schemas.microsoft.com/cdo/configuration/"
flds.Item(schema & "sendusing") = cdoSendUsingPort
flds.Item(schema & "smtpserver") = "mail.myserver.com" 'your info here
flds.Item(schema & "smtpserverport") = 25
flds.Item(schema & "smtpauthenticate") = cdoBasic
flds.Item(schema & "sendusername") = "email#email.com" 'more of your info
flds.Item(schema & "sendpassword") = "password"
flds.Item(schema & "smtpusessl") = False
flds.Update
With imsg
.To = strTo
.From = strFrom
.Subject = strSubj
.HTMLBody = strBody
'.body = strBody
'.Sender = "Sender"
'.Organization = "My Company"
'.ReplyTo = "address#mycompany.com"
Set .Configuration = iconf
.Send
End With
Set iconf = Nothing
Set imsg = Nothing
Set flds = Nothing
End Sub
You could either loop through the resultset of your query and call your sendmail function for each email, or write a quick helper function that fetches and concatenates your email fields into a ";" delimited list, and just send the email once with multiple recipients.
If the essence of your question is about the actual sending of the email message itself, then you may find that DoCmd.SendObject may not be the best method. It has several limitations, most significantly (ref: here)
the message text is limited to 255 characters
it depends on interaction with an email client application (via MAPI, I assume) so it may not work if there is no mail client configured, or if the mail client is not a Microsoft product
Instead, you might consider sending the messages via CDO. There is a good write-up and some ready-to-use VBA code here:
http://www.cpearson.com/excel/Email.aspx
I am trying to auto email a report from access using VBA in a macro. The report is sent from Access2007 by outlook2007. When the report is being sent, I get a security message from outlook saying "a program is trying to access your Address book or Contacts" or "a program is trying to access e-mail addresses you have stored in Outlook..." . This message is a problematic for me because I want to use windows task scheduler to automatically send the report without any human interaction.So I want to disable this security notification. I searched on Google and here is the code I have so far but giving me errors and I am not sure what else I should do. Thanks for your help in advance. I am a beginner programmer. The error is
Public Sub Send_Report()
Dim strRecipient As String
Dim strSubject As String
Dim strMessageBody As String
Dim outlookapp As Outlook.Application
Set outlookapp = CreateObject("Outlook.Application")
OlSecurityManager.ConnectTo outlookapp 'error is here says object required
OlSecurityManager.DisableOOMWarnings = True
On Error GoTo Finally
strRecipient = "example#yahoo.com"
strSubject = "Tile of report"
strMessageBody = "Here is the message."
DoCmd.SendObject acSendReport, "Report_Name", acFormatPDF, strRecipient, , , strSubject, strMessageBody, False
Finally:
OlSecurityManager.DisableOOMWarnings = False
End Sub
You get the error because OlSecurityManager is nothing. You haven't declared it, you haven't set it to anything, so when you attempt to use it, VBA has no idea what you're talking about!
It looks like you're trying to use Outlook Security Manager, which is an add-in sold here. Have you purchased it? Because if not, then you probably don't have it on your system.
If you do have it, then you probably need to declare and set it like this:
Dim OlSecurityManager As AddinExpress.Outlook.SecurityManager
Set OlSecurityManager = New AddinExpress.Outlook.SecurityManager
If you, as I suspect, don't have it, then an alternative is sending e-mail using CDO. Here's an example:
First, set a reference to the CDO library in Tools > References > checkmark next to Microsoft CDO for Windows Library or something like that.
Dim cdoConfig
Dim msgOne
Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServerPort) = 25 'your port number, usually is 25
.Item(cdoSMTPServer) = "yourSMTPserver.com"
'.Item(cdoSendUserName) = "your username if required"
'.Item(cdoSendPassword) = "your password if required"
.Update
End With
Set msgOne = CreateObject("CDO.Message")
With msgOne
Set .Configuration = cdoConfig
.To = "recipient#somehwere.com"
.from = "you#here.com"
.subject = "Testing CDO"
.TextBody = "It works just fine."
.Attachments.Add "C:\myfile.pdf"
.Send
End With
This is a bit more annoying than Outlook, because you need to know in advance the address of the SMTP server to be used.
I know this is a late answer, but I just ran into a similar problem. There is another solution using Outlook.Application!
I stumble upon it while looking for the solution, full credit here:
http://www.tek-tips.com/faqs.cfm?fid=4334
But what this site's solution simply suggest, instead of using the .send command, use the `.Display" command and then send some keys from the keyboard to send the email, like below:
Sub Mail_workbook_Outlook()
'Working in Excel 2000-2016
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "Someone#Somewhere.com"
.CC = ""
.BCC = ""
.Subject = "This is an automated email!"
.Body = "Howdy there! Here, have an automated mail!"
.Attachments.Add ActiveWorkbook.FullName
.Display 'Display instead of .send
SendKeys "%{s}", True 'send the email without prompts
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End
End Sub