I have the following snippet of code within my onload function. Checking to see if the date is Monday and if so then check within the log_EmailProductionSchedule to see if todays date is logged. If not the app will automatically send the email and add a log to this table with todays date, preventing the application from sending another email. However, each time I open the application the email is being generated and a new log is being inserted. where have I gone wrong with this code?
If Weekday(Now) = vbMonday Then
If DCount("*", "log_EmailProductionSchedule", "[sentDate] = #" & Format(Now, "mm\/dd\/yyyy") & "#") = 0 Then
'send email
Call SendProductionEmail
CurrentDb.Execute ("INSERT into log_EmailProductionSchedule (sentDate) select date()")
End If
End If
Set a break point on DCount. Your variables are probably not being set to what you think they are.
Instead if messing around with Format just use the date function
If Weekday(Now) = vbMonday Then
If DCount("*", "log_EmailProductionSchedule", "[sentDate] = Date()") = 0 Then
'send email
Call SendProductionEmail
CurrentDb.Execute ("INSERT into log_EmailProductionSchedule (sentDate) select date()")
End If
End If
click here to learn about the peculiarities with VBA and SQL in MS Access. TL:DR; Jet, the database engine that runs your SQL uses whatever your machine regional settings are, but VBA is fixed to mm/dd/yyyy
Related
I have an SQL statement in VBA that when i run it, it updates my table with incorrect information. I've been struggling with this code for over a week trying workarounds and debugging but to no avail. I've searched online and found nothing even close to this.
DIM SQL as String
DIM periodStart as Date
DIM periodEnd as Date
periodStart = DateSerial(Year(Date), 12, 1)
periodEnd = DateSerial(Year(Date), 12, 15)
MsgBox "Period Start: " & periodStart & " Period End: " & periodEnd
SQL = "UPDATE EmpTime SET EmpTime.beginning = " & periodStart & " & EmpTime.ending = " & periodEnd & ";"
DoCmd.RunSQL SQL
The above code gives me a message box that shows me the periodStart and periodEnd variables are being built properly but then when i look to the table, the information is not the same as the Message box.
MsgBox
Table
Why is this happening and what can I do to fix it/avoid it ?
What I think is happening here is that your SQL is shaking out to be:
UPDATE EmpTime SET EmpTime.beginning = 12/1/2019, EmpTime.ending = 12/15/2019;
Access is not super amazing at guessing your intentions when you just send it math problems like this. Because it doesn't recognize your first date as a properly formatted string (12/01/2019 would be more appropriate) it is making the educated guess that you literally wanted to divide 12 by 1 by 2019. Which results in a decimal, or a very early time of the first date that MS Access can record: 12/30/1899 (like 12:05am, but there is no time dimension in play so it's dropped).
Instead try:
UPDATE EmpTime SET EmpTime.beginning = #" & Format(periodStart, "mm/dd/yyyy") & "# & EmpTime.ending = #" & Format(periodEnd, "mm/dd/yyyy") & "#;"
This does two things:
It formats (using the Format() function) your date into something access will recognize on its own.
It surrounds the date in # which is the microsoft office-y way of saying "This is explicitly a date, treat it as such or throw an error". Which is a much better scenario then "Guess what I meant when I send you this math/date"
Lastly, as Gordon mentions, and I also HIGHLY recommend is to switch this code over to use parameterized inputs in your SQL. here is a good write up of what that looks like. This solves two issues in your current code
Your malformed date would most likely error on being assigned to the correctly typed parameter before the SQL was executed alerting you that you have a bad date. (no guessing what went wrong and no bad data hitting your database)
You are protected from SQL Injection by users of your workbook. I assume this is not a super important facet of your workbook/application though since this is probably an internal company or personal thing and everyone using it can be trusted, but I am always in favor of hardening your code as best as possible since it's just good practice.
SQL = "UPDATE EmpTime SET EmpTime.beginning = #" & periodStart & "#, EmpTime.ending = #" & periodEnd & "#"
I have been struggling with a need I had for several month and today I found the solution, or workaround if you'd like, to it.
The solution was inspired on a post I found here:
how to pass parameters to query in SQL (Excel)
And, even though I wanted to thank #mono código for the idea, I couldn't comment on the post anything on the original thread due to my lack of reputation. So I thought of posting this to thank and also to help others with the struggle.
My first approach for this was using Power Query, but doing modifications to the script afterwards is very complicated. This approach is much more simpler IMO.
It is basically getting the command text of your connection and modifying it on the fly:
With ActiveWorkbook.Connections("MyConnection").OLEDBConnection
queryOriginalText = .CommandText
queryPreText = .CommandText
queryPostText = Replace(queryPreText, "SET #From=#From", "SET #From='" & Range("StartDate") & "'")
queryPreText = queryPostText
queryPostText = Replace(queryPreText, "SET #To=#To", "SET #To='" & Range("EndDate") & "'")
queryPreText = queryPostText
queryPostText = Replace(queryPreText, "SET #OrderNo=#OrderNo", "SET #OrderNo='" & Range("OrderNo") & "'")
.CommandText = queryPostText
ActiveWorkbook.Connections("MyConnection").Refresh
.CommandText = queryOriginalText
End With
My script has 3 variables that I use as conditions to filter my data:
#From, #To and #OrderNo. And, when I set those on my script I do it like this:
SET #From=#From
SET #To=#To
SET #OrderNo=#OrderNo
In my VBA I look for those specific strings and replace them one by one with values that the user input on the Sheet, on specific cell with Range names.
At the end I put back the original text so the strings to replace are always there when the user hit the button that runs the macro. This only works if you unchecked the option
Connection Properties
otherwise you will get a runtime error.
I hope this helps
Are you saying you need to pass variable to the ConnectionString? That doesn't seem right at all. Pass dates to the Query that is passed to the ConnectionSting. Follow this example.
Private Sub CommandButton1_Click()
Dim FromDate As Date
Dim ToDate As Date
FromDate = Format(Sheets("Sheet1").Range("B1").Value, "yyyy-mm-dd") 'Pass value from cell B1 to SellStartDate variable
ToDate = Format(Sheets("Sheet1").Range("B2").Value, "yyyy-mm-dd") 'Pass value from cell B2 to SellEndDate variable
MsgBox FromDate
MsgBox ToDate
'Pass the Parameters values to the stored procedure used in the data connection
With ActiveWorkbook.Connections("TestConnection").OLEDBConnection
.CommandText = "EXEC dbo.spr_TestProcedure '" & FromDate & "','" & ToDate & "'"
ActiveWorkbook.Connections("TestConnection").Refresh
End With
End Sub
Also, it may be helpful to follow the example from the link below.
https://www.mssqltips.com/sqlservertip/3436/passing-dynamic-query-values-from-excel-to-sql-server/
Post back if you are still having an issue with this.
I have two parameters form a FROM and THRU textbox. The code object is txtFROM and txtTHRU. Now I tried to open the query and reports with a txtFROM.SetFocus and txtTHRU.SetFocus and used in the query criteria: Between [FORMS]![ReportName]![txtFROM].[Text] and [FORMS]![ReportName]![txtTHRU].[Text]. However nothing turns up when I link a button to the query and report to show the data with those two parameters. I think it may be due to the fact that the .SetFocus method will only work on one parameter, so I think writing VBA variables to pass into a query might work if possible. The thing is I do not know if it is possible to call a VBA variable while running to a query as it were an object. The variables would otherwise read .SetFocus to ready the parameter to be passed to the Access query.
DoCmd.SetWarnings False
If IsNull(txtFROM.Value) = False And IsNull(txtTHRU.Value) = False Then
dataFROM = CDate(txtFROM.Value)
dataTHRU = CDate(txtTHRU.Value)
End If
DoCmd.OpenQuery ("Expiring")
DoCmd.OpenReport ("Expirees"), acViewPreview
DoCmd.SetWarnings True
The above variables dataFROM and dataTHRU would be what I would like to fit in the query criteria to reference the Form which displays reports.
You might need to script the query "on the fly" by using CreateQueryDef. Sort of like:
Dim db as Database
Dim qdf as QueryDef
Set db = CurrentDB
Set qdf = db.CreateQueryDef("Expiring", "SELECT * FROM MyTable WHERE " &_
"MyDate >= #" & CDate(txtFROM.Value) & "# and MyDate =< #" CDate(txtTHRU.Value) & "#")
DoCmd.OpenReport "Expirees", acViewPreview
Of course, you'll probably need to add some code at the beginning to delete that query if it already exists. Definitely inside an If/Then because if the code happens to burp and doesn't create the query one time, it'll crash the next time you run it.
Edit
As suggested by HansUp, another option is simply to alter the query's SQL statement, which you can do in code.
Set myquery = db.OpenQueryDef("Expiring")
strsql = "SELECT * FROM MyTable WHERE " &_
"MyDate >= #" & CDate(txtFROM.Value) & "# and MyDate =< #" CDate(txtTHRU.Value) & "#"
myquery.SQL = strsql
myquery.Close
It looks like there was a mixup in my query code, the FROM was duplicated, FROM FROM, not FROM THRU. The code works as it should have with the reference to the Reports and Form which the text controls. Keep with the usual method then.
What i am trying to do is when i click a button i created i have data imported into a table. This works great right now. What i am wondering if there is a way that when i click this button if i can have a parameter box come up asking for the date that this data is from. once the user types that date in the date will be placed into a column(field) named timestamp.
Does this make sense? I have looked up on how to do this but i just found how to use parameters on querys.
I could really use the help. Thank you for the help in advanced.
You could do something like the following:
'... your existing code
dim dtTimeStamp
dtTimeStamp = InputBox("Please enter a date:")
'may want to validate date
If not isdate(dtTimeStamp) then
msgbox "Bad date"
end if
doCmd.RunSQL "Update TableX Set TimeStamp = #" & Format(dtTimeStamp, "yyyy-mm-dd") & "# where TimeStamp is Null"
I use Outlook 2007 on Windows 7. I have recently installed iCloud have unfortunately realised that Google Calendar Sync will only sync the default calendar. I was wondering if someone could help me out with a simple VBA macro that would
Empty the default calendar of all appointments
Copy all appointments from the iCloud Calendar to the default calendar
Many thanks!
Health warning
Everything in this answer was discovered by experimentation. I started with VB Help, used F2 to access the object model and experimented until I found what worked. I did buy a highly recommended reference book but it contained nothing important I had not discovered and omitted much that I had discovered.
I suspect that a key feature of the knowledge I have gained is that it is based on many different installations. Some of the problems encountered may have been the result of installation mistakes which would explain why reference book authors did not know of them.
The code below has been tested with Outlook 2003. I have tested similar code with Outlook 2007.
Output selected properties of appointments within default Calendar to Immediate window
You reported that the first version of this routine gave an error: "Runtime error '-2147467259 (80004005)': You must enter a positive duration."
According to the websites I found with Google, error 80004005 means a system file is corrupt.
An appointment has three related items: Start (type Date), End (type Date) and Duration (type Long). I assume either End or Duration is derived at runtime. My guess is that either Duration is negative or End is before Start. I notice in the list of appointments created by this macro on my system that some all day events have property AllDayEvent = False. I seem to recall I once discovered that creating an appointment and later switching AllDayEvent on or off created an inconsistency.
I have added code which attempts to detect this problem but I cannot test it because I have no appointments that give this error on my system. This macro was only intended to get you started with a list of your current appointments so let us not worry to much if you cannot get it working.
Sub ReviewCalendar()
Dim DateTimeEnd As Date
Dim DateTimeStart As Date
Dim Duration As Long
Dim ItemMine As Object
Dim ItemMineClass As Long
Dim FolderTgt As MAPIFolder
Set FolderTgt = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
' I use this macro to list selected properties from the test calendar.
' Add a quote to the statement above and remove the quote from the next
' statement to do the same.
'Set FolderTgt = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").Folders("Test Folders"). _
Folders("Calendar")
For Each ItemMine In FolderTgt.Items
With ItemMine
' Occasionally I get syncronisation
' errors. This code avoids them.
ItemMineClass = 0
On Error Resume Next
ItemMineClass = .Class
On Error GoTo 0
If ItemMineClass = olAppointment Then
Debug.Print "** Subject: " & .Subject
Debug.Print " Created: " & _
Format(.CreationTime, "d mmm yy hh:mm:ss")
Debug.Print " Updated: " & _
Format(.LastModificationTime, "d mmm yy hh:mm:ss")
Debug.Print " Time: ";
DateTimeStart = .Start
If .AllDayEvent Then
Debug.Print "All day " & Format(.Start, "d mmm yy")
Else
On Error Resume Next
DateTimeEnd = .End
Duration = .Duration
On Error GoTo 0
If Duration <= 0 Then
Debug.Print " ##### Invalid duration #####"
End If
Debug.Print Format(.Start, "h:mm") & " to " & _
Format(.End, "h:mm") & "(" & .Duration & _
" minutes) on " & Format(.Start, "d mmm yy")
End If
' If you remove the quote from the following statement
' it will delete the appointment.
' .Delete ' Delete appointment
End If
End With
Next
End Sub
Preparing to test copying of appointments
I suggest you create a test folder so you can test macros without effecting anything important.
From the Toolbar, select File, New, Outlook Data File, Office Outlook Personal Folders File (.pst).
A window appears listing your existing PST files. On my system these are: archive.pst, Outlook.pst and Test.pst.
At the bottom the default file name is selected. Enter "Test" or other name of your choice.
Another window appears so you can (1) select the name used for the new personal folder in the Outlook Explorer window and (2) select the level of encryption. Enter "Test" or other name of your choice. (Outlook will add " Folders" to your name.) I do not encrypt or password protect message on my system but that is a choice for you.
From the toolbar, select Go, Folder List. The folder list will appear in place of the Output Explorer window.
Right click folder "Calendar" then select New Folder. The New Folder window appears.
Enter the name as "Calendar" and select Test Folders as its location.
Now, when you select Calendar, you will be offered "Calendar in Test Folders" as an additional choice.
Copy appointments from default Calendar to test Calendar
This macro creates a copy in the test Calendar of every appointment in the default Calendar.
Run it once then select Calandar and tick both the default and the test Calendar. The two calendars should be identical.
Warning: If you run the macro again, you will end with two copies of each appointment.
Sub CopyCalendar()
Dim FolderDest As MAPIFolder
Dim ItemCopy As AppointmentItem
Dim ItemMine As Object
Dim ItemMineClass As Long
Dim NameSpaceMine As NameSpace
Dim FolderSrc As MAPIFolder
Set NameSpaceMine = _
CreateObject("Outlook.Application").GetNamespace("MAPI")
With NameSpaceMine
Set FolderSrc = .GetDefaultFolder(olFolderCalendar)
Set FolderDest = .Folders("Test Folders").Folders("Calendar")
End With
Debug.Print FolderSrc.Items.Count
Debug.Print FolderDest.Items.Count
For Each ItemMine In FolderSrc.Items
With ItemMine
' Occasionally I get syncronisation
' errors. This code avoids them.
ItemMineClass = 0
On Error Resume Next
ItemMineClass = .Class
On Error GoTo 0
' I have never found anything but appointments in
' Calendar but test just in case
If ItemMineClass = olAppointment Then
Set ItemCopy = .Copy
ItemCopy.Move FolderDest
End If
End With
Next
End Sub
Next steps
The Set FolderDest statement shows how to select a partcular folder by working down its hierarchy. There are other, more general, techniques but this should be sufficient for your requirements if you can access the iClound Calendar in this way.
Set NameSpaceMine = _
CreateObject("Outlook.Application").GetNamespace("MAPI")
With NameSpaceMine
Set FolderDest = .Folders("Test Folders").Folders("Calendar")
End With
The first macro includes the code to delete every appointment in a calendar and the second copies appointments from one calendar to another.
Combining and adapting this code would give you a one-way synchronisation. That is, it would make Calendar 2 a copy of Calendar 1. Is this adequate? Would overwriting the iCloud Calendar with the default Calendar be adequate? Two-way synchronisation is more complicated. I have experienced several "enterprise" synchronisation routines and none were fool-proof. If you are of the "enterprise means over priced, poor quality sofware" school, you will not be surprised. Otherwise you may agree that two-way synchronisation is difficult or that both statements are true.
The issues are:
Non-identifying properties in either calendar may be changed.
An appointment may be added to or deleted from either calendar.
Identifying properties in either calendar may be changed. Typically subject and or start time are identifying properties but the subject may be changed and the appointment may be moved.
On my system, CreationTime and LastModificationTime are copied unchanged so there are options around using them as identifiers. I have no means of testing the effect on CreationTime and LastModificationTime of a calendar being updated because of meeting request.
I leave you to consider these issues and decide how you wish to take this matter forward.