I am trying to get the time to change to 9am. It hasn't worked or has removed the preceding DateAdd("d", 2, now) which assigns it for 2 days time.
replyEmail.DeferredDeliveryTime = DateAdd("d", 2, Now)
I tried different DateTime functions, defining certain values, e.g. Date + Time("09:00:00")
After playing around for two days, it appears I've stumbled upon my answer.
replyEmail.DeferredDeliveryTime = DateAdd("d", 2, Date) + DateAdd("n", 0, #9:00:00 AM#)
My issue was finding the right object and then how to join the two so the function didn't override itself causing only the date or time to be correct, but not both.
I'm sure there is a way to make this look cleaner and if I discover it, I'll post but this does the job for the time being.
Option Explicit
Sub deferredDelivery_2D9H()
Dim mItem As MailItem
Dim d2_9AM As Date
Debug.Print "Date + 2 time format......: " & Format(Date + 2, "ddddd hh:nn")
d2_9AM = DateAdd("h", 9, Date + 2)
Debug.Print "d2_9AM....................: " & d2_9AM
Set mItem = CreateItem(olMailItem)
mItem.DeferredDeliveryTime = d2_9AM
Debug.Print "mItem.DeferredDeliveryTime: " & mItem.DeferredDeliveryTime
mItem.Display
' "Do not deliver before" entry in Options Tracking Properties dialog
'ActiveInspector.CommandBars.ExecuteMso ("DelayDeliveryOutlook")
' Options Tracking Properties dialog
ActiveInspector.CommandBars.ExecuteMso ("MessageOptions")
End Sub
Related
I have too many meetings at work, so I thought I might use an Outlook VBA macro to block my calendar when I have too many meetings, so I can use the rest of the time to actually get things done.
`Sub BlockMoreCalendarAppts()
Dim myAcct As Outlook.Recipient
Dim myFB As String
Dim tDate As Date
Dim d As Long
Dim i As Long
Dim test As String
Dim oAppt As AppointmentItem
' it needs to know whose FB to check
Set myAcct = Session.CreateRecipient("name.lastname#domain.com")
' days to check
For d = 0 To 5
tDate = Date + d
' use start of working day or there about
' false counts tenetive and oof as busy
myFB = myAcct.FreeBusy(tDate + #9:30:00 AM#, 5, False)
' this gets the # of 5 min periods before the start time
i = (TimeValue(tDate + #9:30:00 AM#) * 288)
' only count free busy for 7:10 hours from start + at least 1 additional 5 min period
' # of min in working day / 5
' skips busy times in the evening
test = Mid(myFB, i, 435 / 5)
CountOccurrences = UBound(Split(test, "1")) ' busy, oof or tentative
' theoretical WHERE statement goes here?
CountO = UBound(Split(test, "0")) ' free
'round to hours for subject
times = Round(((CountOccurrences * 5) / 60), 2)
' create all day busy event
' there are 12 5 minute periods per hour
' 60 = 5 hours
If CountOccurrences >= 60 Then
' default calendar
Set oAppt = Application.CreateItem(olAppointmentItem)
With oAppt
.Subject = times & " hours of appt today"
.Start = tDate
.ReminderSet = False
.Categories = "Full Day"
.AllDayEvent = True
.BusyStatus = olBusy
.Save
End With
End If
' check next day
Next d
End Sub`
The logic is that if I have more than 5 hours of meetings in a day, it sets an all day appointment and marks me as busy.
I tested the attached macro, which works, but, I want to filter out appointments which contain certain words in the subject. For example, "Lunch" or "Focus". In other words, I don't want "Lunch" to be counted in my five hours of meetings.
I have not figured out how to use a WHERE function to filter particular appointments for that day. Any help would be appreciated.
This is based (heavily) on the great work of Diane Poremsky at https://www.slipstick.com/outlook/calendar/limit-number-appointments-day/
If you switch to looping through appointments then you could add them all up like that? Pseudocode:
' Set the start and end times for the day
Dim startTime As Date
startTime = DateSerial(year, month, day) + TimeValue("9:00 AM")
Dim endTime As Date
endTime = DateSerial(year, month, day) + TimeValue("5:00 PM")
' Set the search criteria for the appointments
Dim filter As String
filter = "[Start] >= '" & startTime & "' AND [End] <= '" & endTime & "'" & _
"AND [Subject] NOT Like '*focus*'"
' Get the calendar folder for the default account
Dim calendarFolder As Folder
Set calendarFolder = Application.Session.GetDefaultFolder(olFolderCalendar)
' Set the current appointment to the first appointment of the day
Dim currentAppointment As AppointmentItem
Set currentAppointment = calendarFolder.Items.Find(filter)
' Loop through all appointments on the day
Do While Not (currentAppointment Is Nothing)
' Process the current appointment
' ...
' Get the next appointment
Set currentAppointment = calendarFolder.Items.FindNext
Loop
I'm struggeling to format my date strings correctly as it appears to be minusing the wrong parts of my date using DateAdd and I'm not sure how to resolve.
Eg:
Sub DateTest()
DateStr = Format(Date, "DD-MM-YY")
Yesterday = Format(DateAdd("d", -1, CDate(DateStr)), "DD-MM-YY")
YtdStr = Format(Yesterday, "DD-MM-YY")
Debug.Print DateStr
Debug.Print Yesterday
Debug.Print YtdStr
End Sub
Result:
13-09-20
19-09-13
13-09-19
Expected Result:
13-09-20
12-09-20
12-09-20
I even tried using just "day of year" as this is for an hidden report, but I like using regular date strings I think or at least I'd like to get both figured out, but using day of year showed me some interesting results. Yesterday had to be d 0 which made no sense, but if I used -1 it removed two dates. As well, turning that into a string seems to remove another day?
Eg:
Sub DateTest()
DateStr = Format(Date, "Y")
YtdDate = Format(DateAdd("d", 0, CDate(DateStr)), "Y")
YtdStr = Format(YtdDate, "Y")
Debug.Print DateStr
Debug.Print YtdDate
Debug.Print YtdStr
End Sub
Resut:
257
256
255 'This was expected to be a string 256?
Can anybody point out how to format this correctly?
You are formatting the source date as string using DD-MM-YY, parsing it back to date using your current system default date format (apparently MM-DD-YY), adding days to the result of that, and formatting it back to string. You don't want these intermediate formatting to strings.
Sub DateTest()
Dim DateNotStr As Date
Dim YesterdayNotStrEither As Date
DateNotStr = Date
YesterdayNotStrEither = DateAdd("d", -1, DateNotStr)
Debug.Print Format$(DateNotStr, "dd-mm-yy")
Debug.Print Format$(YesterdayNotStrEither , "dd-mm-yy")
End Sub
I think the issue was CDate wasn't transforming my date correctly based on my systems default date format. I created a variable for today in date format and used that to generate yesterdays variable.
Eg:
Public Sub SetDateVars()
TdDate = Date
TdStr = Format(Date, "DD-MM-YY")
YtdDate = Format(DateAdd("d", -1, TdDate))
YtdStr = Format(YtdDate, "DD-MM-YY")
Debug.Print TdDate
Debug.Print TdStr
Debug.Print YtdDate
Debug.Print YtdStr
End Sub
Result:
9/13/2020
13-09-20
9/12/2020
12-09-20
I have below dates in an Excel column, as you can see.
Sprint 1 takes from 10.04 to 21.04 this means 2 weeks and between brackets they are specified week 15 and 16 which is correct but for Sprint 2, who also starts in 10.04 but takes until 05.05 it means 7 weeks, but are displayed also the weeks from the Sprint1.
"Sprint1 (CW15-16/2017)
[10.04.2017 - 21.04.2017]
Sprint2 (CW15-16/2017)
[10.04.2017 - 05.05.2017]"
What I have until now is:
'reading the first CW of the sprint based on the date
SprintFristCW = Left(planning_wb.Worksheets(SprintPlanningTable).Cells(2, i + 1).Value, 9)
'reading the last CW of the Sprint based on the date
SprintEndCW = Right(planning_wb.Worksheets(SprintPlanningTable).Cells(2, i + Sprintlength).Value, 9)
SprintCW = Left(SprintFirstCW, 4) & "-" & Right(SprintEndCW, 7)
But SprintEndCW is not reading correct the week number.
So I need to read the correct week number in which each sprint ends and print it.
Don't create huge procedures. Small is beautiful. Create functions that feed into your Main procedure. Here is an example. The procedure TestExtraction calls the function ExtractWeeks. Therefore ExtractWeeks needs not be part of the procedure that calls it, making the code easier to understand and maintain.
Private Sub TestExtraction()
Dim Fun As Long
Dim DateString As String
Dim StartDate As Date, EndDate As Date
DateString = ActiveCell.Value
' the DateString is re-defined here for testing purposes
DateString = "[10.04.2017 - 05.05.2017]"
Fun = ExtractWeeks(DateString, StartDate, EndDate)
If Fun < 0 Then
Debug.Print "Invalid date"
Else
With Application
DateString = "(CW" & .WeekNum(StartDate)
If Year(StartDate) <> Year(EndDate) Then _
DateString = DateString & "/" & Year(StartDate)
DateString = DateString & " - " & .WeekNum(EndDate) & "/" & Year(EndDate) & ")"
End With
Debug.Print DateString
Debug.Print Fun & " weeks"
End If
End Sub
Private Function ExtractWeeks(ByVal DateString As String, _
StartDate As Date, _
EndDate As Date) As Long
' 24 Oct 2017
' return the number of weeks between dates (rounded up)
' return -1 if one of the dates is unreadable
Dim Dates() As String
Dim i As Integer
Dates = Split(Mid(DateString, 2, Len(DateString) - 2), "-")
On Error Resume Next
For i = 0 To 1
Dates(i) = Replace(Trim(Dates(i)), ".", Application.International(xlDateSeparator))
Next i
StartDate = DateValue(Dates(0))
EndDate = DateValue(Dates(1))
If Err Then
ExtractWeeks = -1
Else
ExtractWeeks = Int((StartDate - EndDate) / 7) * -1
End If
End Function
The point is that not everything that looks like a date is a date Excel can understand. The Function ExtractWeeks converts the "dates' from your worksheet into real dates and returns these dates to the calling procedure. It also returns -1 in case of error which you can use to trap such errors. In my example, the function returns the number of weeks (or -1). You might let it return the CW string my calling procedure constructs. You will find it easy to move the process of constructing that string to the function and let the function return "" in case of error instead of -1. Perhaps you can exclude the possibility of errors in the dates. This is a question of how you integrate the function into your Main.
I have data for a date that looks like this: "2015-02-11T19:41:50-08:00"
I would like to know if there is already a function that exists in VBA which can convert the above data to the format of something like "02/11/2015 11:41 AM PST"
I attempted the following code playing around with the format function but was unable to get VBA to recognize the format as a date:
testdate = "2015-02-12T22:57:05-08:00"
newdate = Format(testdate, "mm/dd/yyyy hh/nn/ss AM/PM")
Debug.Print newdate
The output was still "2015-02-12T22:57:05-08:00"
Thanks for the help.
Edit:
I was able to resolve the problem by taking your suggestions to use the mid() function since the dates are in fixed format. I decided to keep the military time in the final version.
Here is my code for anyone curious:
Function convertDate(orderdate)
'takes the date formatted as 2015-02-06T08:26:00-08:00
'and converts it to mm/dd/yyyy hh/nn/ss UTC format
'2015-02-06T08:26:00-08:00
orderyear = Mid(orderdate, 1, 4)
ordermonth = Mid(orderdate, 6, 2)
orderday = Mid(orderdate, 9, 2)
orderhour = Mid(orderdate, 12, 2)
orderminute = Mid(orderdate, 15, 2)
ordersecond = Mid(orderdate, 18, 2)
newdate = ordermonth & "/" & orderday & "/" & orderyear
newtime = orderhour & ":" & orderminute & ":" & ordersecond
'Debug.Print newdate
convertDate = newdate & " " & newtime & " UTC"
End Function
Because your input isn't a true date none of Excel or VBA's date methods will work with it. Your best bet is to break the string down into parts, work with them individually, and then join it all back up again - for example:
testdate = "2015-02-12T22:57:05-08:00"
'// The letter T is redundant, so let's split the string here into an array:
dateArr = Split(testdate, "T")
'// Part 1 of the array can be easily converted with CDate() and Format()
dateArr(0) = Format(CDate(dateArr(0)), "mm/dd/yyyy")
'// Part 2 of the array will need to be broken down further:
dateArr(1) = Format(TimeValue(Split(dateArr(1), "-")(0)) - _
TimeSerial(Left(Split(dateArr(1), "-")(1), 2), _
Right(Split(dateArr(1), "-")(1), 2), 0), "hh:mm:ss")
'// The above line does the following:
'// 1) Split the second part of the array again, using the "-" as the delimiter
'// 2) Convert the first part of this (22:57:05) to a time using TimeValue()
'// 3) Convert the second part (08:00) to hours & minutes using TimeSerial()
'// 4) Minus the latter from the former (which can only be done if both are a valid time)
'// 5) Wrap all that into a Format() method to show "hh:mm:ss" instead of a Double.
'// Join the two parts back together and add "PST" on the end.
newdate = Join(dateArr, " ") & " PST"
Debug.Print newdate
'// Output will display "02/12/2015 14:57:05 PST"
N.B. I have chosen not to include "AM" or "PM" because your time is in 24hr format anyway so I don't see the relevance...
It's not converting because of the "T" and because of the tacked on time range at the end. You can ditch the "T" and truncate off the trailing range and it will convert.
Public Sub Example()
Const testValue As String = "2015-02-12T22:57:05-08:00"
Dim dateValue As Date
Dim stringValue As String
Dim subVal As Date
Dim hyphenPos As Long
stringValue = testValue
Mid(stringValue, 11&, 1&) = " "
hyphenPos = InStrRev(stringValue, "-")
subVal = Mid$(stringValue, hyphenPos + 1&)
dateValue = CDate(Left$(stringValue, hyphenPos - 1&)) - subVal
End Sub
Couple of ideas:
The sample date you have 2015-02-12T22:57:05-08:00 is not a real date (I think)
I think the following will give you the closest format to what you are looking for (you will need to define the range.Range.NumberFormat = "[$-409]h:mm:ss AM/PM"
Your best bet is concating "PST" to a date datatype formatted to your needs.
Sub DebugPrintDate()
Dim testdate As Date: testdate = Now
newdate = Format(testdate, "mmm/dd/yyyy hh:mm AM/PM") & " PST"
Debug.Print newdate
End Sub
Ouput:
Never mind the "févr". My system locale is France.
If you want to define a particular date, make sure to wrap the date in two #s.
Example:
Dim someDateAndTime As Date = #8/13/2002 12:14 PM#
I am building a reconciliation tool via VBA that automates queries from my oracle database and a worksheet. When I run the query I want the user to input what ITEM (in this case pipeline) to query (the worksheet has many items) and the end/start dates. I am having trouble figuring out the following:
1) It is querying - if the value is NULL, how may I tell it to print out "DATA NOT AVAILABLE"
2) How can I clear up the old output from pipeline A, when I am querying pipeline B?
3) My dates are saved as strings in Oracle - how can I convert that to date?
Thank you!
Here is what I have so far:
Option Explicit
Option Base 1
Dim cnnObject As ADODB.Connection
Dim rsObject As ADODB.Recordset
Dim strGPOTSConnectionString As String
Dim startDate As Date
Dim endDate As Date
Dim strPipelineName As String
Dim strQuery As String
Sub ClickButton2()
Debug.Print ("Button has been clicked")
Dim Pipeline As String
Dim DateStart As Date
Dim DateEnd As Date
Pipeline = InputBox("Enter PipeLine", "My Application", "Default Value")
DateStart = InputBox("Enter Start Date", "My Application", DateTime.Date)
DateEnd = InputBox("Enter End Date", "My Application", DateTime.Date + 1)
Pipeline = Range("B1").Value
DateStart = Range("B2").Value
DateEnd = Range("B3").Value
strQuery = "select pipelineflow.lciid lciid, ldate, volume, capacity, status, " & _
"pipeline, station, stationname, drn, state, county, owneroperator, companycode, " & _
"pointcode, pottypeind, flowdirection, pointname, facilitytype, pointlocator, " & _
"pidgridcode from pipelineflow, pipelineproperties " & _
"where pipelineflow.lciid = piplineproperties.lciid " & _
"and pipelineflow.audit_active = 1 " & _
"and pipelineproperties.audit_active =1 " & _
"and pipelineflow.ldate >= '" & Format(DateStart, "dd-MMM-yyyy") & "' and pipelineflow.ldate < '" & Format(DateEnd, "dd-MMM-yyyy") & "' " & _
"and pipelineflow.ldate >= '" & DateStart & "' and pipelineflow.ldate < '" & DateEnd & "' " & _
"and pipelineproperties.pipeline = '" & Pipeline & "' "
Call PullZaiNetData(strQuery)
Call TieOut
End Sub
Sub PullZaiNetData2(ByVal strQry As String)
Set cnnObject = New ADODB.Connection
Set rsObject = New ADODB.Recordset
strGPOTSConnectionString = "DRIVER={Microsoft ODBC for Oracle}; SERVER=hhh; PWD=hhhh; UID=hhh"
cnnObject.Open strGPOTSConnectionString
rsObject.Open strQry, cnnObject, adOpenStatic
Worksheets("ZaiNet Data").Cells(1, 1).CopyFromRecordset rsObject
rsObject.Close
cnnObject.Close
Set rsObject = Nothing
Set cnnObject = Nothing
End Sub
Sub TieOut()
End Sub
Since you changed your questions, I'll add another answer.
1) It is querying - if the value is NULL, how may I tell it to print out "DATA NOT AVAILABLE"
Which value? I suspect that you mean when the query returns no records. To check this, test for rsObject.RecordCount = 0:
Dim ws As Worksheet
Set ws = Worksheets("ZaiNet Data")
ws.UsedRange.Clear '' remove results of previous query if any
If rsObject.RecordCount = 0 Then
ws.Cells(1, 1) = "DATA NOT AVAILABLE"
Else
ws.Cells(1, 1).CopyFromRecordset rsObject
End If
You can also test for one or both of rsObject.BOF or rsObject.EOF being true ("Beginning Of File" or "End Of File" respectively).
When developing things in VBA, especially when using new features that I'm unfamiliar with, I do lots of tests that output things to the Immediate Window. To help with this, I use the following little routine:
Sub Say(s as String)
Debug.Print s
End Sub
It makes it a little easier to generate testing output that typing "Debug.Print" all the time (even slightly easier than typing "Debug.P" + Enter using Intellisense).
So when you open your recordset, show the record count after it:
rsObject.Open strQry, cnnObject, adOpenStatic
Say rsObject.RecordCount & " records"
Do something like this any time you want to verify a value.
Later on, if you want to capture your debugging statements in a text file, you just need to change the operation of the Say() routine.
2) How can I clear up the old output from pipeline A, when I am querying pipeline B?
As shown in context above:
ws.UsedRange.Clear '' remove results of previous query if any
3) My dates are saved as strings in Oracle - how can I convert that to date?
You don't technically need to convert the resulting date strings to date values, you may find that just by putting them in a cell, Excel will treat them as date values.
You just need to make sure that the user's dates get converted to the format that the database is expecting.
Your query string as it stands above still shows two lines incorporating the user's dates. The one that uses Format() to convert them to "dd-MMM-yyyy" format is the one you want to keep. Delete the other line, making sure your string concatenating syntax is still correct.
To actually convert the date string to a date value though, you would use the CDate() function:
Sub DateTest()
Dim sDate As String
Dim dDate As Date
sDate = "09-Jul-2009"
dDate = CDate(sDate)
Say "sDate = " & sDate
Say "dDate = " & dDate
dDate = dDate + 1
Say "dDate = " & dDate
End Sub
Immediate Window output:
sDate = 09-Jul-2009
dDate = 7/9/2009
dDate = 7/10/2009
We can verify that it converted the string to a date value because it shows up in the default date format for my machine, and responds to date math (adding 1 day).
Answers to previous questions (paraphrased):
1) "how to make sure end date is after start date":
Valid date values are floating point numbers, so DateEnd should be >= DateStart. The whole number part is the number of days since 1900-01-01. The fractional part is the current time of day (eg 12 noon = 0.5).
2) "use fancy calendar entry controls for dates"
Look at the controls available under the Insert> Object menu (in Excel 2003 and earlier - it's in 2007 too, but in a different place). One of them is a Calendar control. Double-clicking it in the Objects list will insert it into the current cell and put the sheet into Design Mode. Right click the control and choose Properties. Type a cell address into the LinkedCell field. Then click the "Exit Design Mode" button from the little toolbar that should have popped up. Now when you select a date on the control, it will show the value in the cell you linked it to.
Similarly there is a drop down list control that you can use to select your pipeline types.
3) "why am I getting an error on DateEnd = Range("B3").Value?"
The DateEnd error is probably due to a missing or invalid value in the cell you specified, as I asked in my comment.
What version of Excel are you doing this in? Excel 2003