I'm currently working on a macro for outlook, to create meetings from a specific date.
My macro can create, modify, delete meetings.
I would like to check if there are conflicts between meetings when I create one.
I've tried to use AppointmentItem.Conflicts property, but I couldn't have any good results.
Thank you for your help.
D
You can use the Recipient.FreeBusy method which returns free/busy information for the recipient. This following VBA example returns a string of free/busy information with one character for each hour (complete format).
Set myRecipient = myNameSpace.CreateRecipient("Nate Sun")
myFBInfo = myRecipient.FreeBusy(#02/05/2022#, 60, True)
To get information for the current user you may use the NameSpace.CurrentUser property which returns the currently logged-on user as a Recipient object, so may call the FreeBusy method on it.
Note, in case of Exchange accounts you may find the ExchangeUser.GetFreeBusy method helpful. It returns a string representing the availability of the ExchangeUser for a period of 30 days from the start date, beginning at midnight of the date specified.
Sub GetManagerOpenInterval()
Dim oManager As ExchangeUser
Dim oCurrentUser As ExchangeUser
Dim FreeBusy As String
Dim BusySlot As Long
Dim DateBusySlot As Date
Dim i As Long
Const SlotLength = 60
'Get ExchangeUser for CurrentUser
If Application.Session.CurrentUser.AddressEntry.Type = "EX" Then
Set oCurrentUser = _
Application.Session.CurrentUser.AddressEntry.GetExchangeUser
'Get Manager
Set oManager = oManager.GetExchangeUserManager
If oManager Is Nothing Then
Exit Sub
End If
FreeBusy = oManager.GetFreeBusy(Now, SlotLength)
For i = 1 To Len(FreeBusy)
If CLng(Mid(FreeBusy, i, 1)) = 0 Then
'get the number of minutes into the day for free interval
BusySlot = (i - 1) * SlotLength
'get an actual date/time
DateBusySlot = DateAdd("n", BusySlot, Date)
'To refine this function, substitute actual
'workdays and working hours in date/time comparison
If TimeValue(DateBusySlot) >= TimeValue(#8:00:00 AM#) And _
TimeValue(DateBusySlot) <= TimeValue(#5:00:00 PM#) And _
Not (Weekday(DateBusySlot) = vbSaturday Or _
Weekday(DateBusySlot) = vbSunday) Then
Debug.Print oManager.name & " first open interval:" & _
vbCrLf & _
Format$(DateBusySlot, "dddd, mmm d yyyy hh:mm AMPM")
Exit For
End If
End If
Next
End If
End Sub
Also you may try to get all meeting that starts or ends in a specific interval. The Find/FindNext or Restrict method can help with such tasks. Read more about them in the following articles:
How To: Use Restrict method in Outlook to get calendar items
How To: Retrieve Outlook calendar items using Find and FindNext methods
Related
First time postings and I'm far from a VBA expert, but I've managed to stumble most of the way to my desired outcome thanks to boards like this one. I'm hoping to automate one last step and am looking for some assistance.
Background:
I run project reports for our Project Managers every Monday morning. The report template queries several tables in our database and populates all of the appropriate fields. It then creates a copy of itself, saves the formulas as values and saves the report using a naming mechanism capturing data from various fields in the report. All of this works great!
The Issue:
At any given time, I have 80-100 active projects. As it stands, I copy the list of projects to a table on the "Parameters" tab. Then, using data validation, I created a dropdown list on the "Report" tab. I then manually go 1 by 1 through the list to generate the report. Each time I change project number in cell B1, the data refreshes and runs the report for the project. I'm using this code to accomplish that:
Private Sub Worksheet_Change(ByVal Target As Range)
'MsgBox Target.Address
If Not Application.Intersect(Range("b1"), Range(Target.Address)) Is Nothing Then
Call AA_RunAll
End If
End Sub
What I'd like to do is create a macro that will run through each one of the projects on my list and run the report. I'm assuming it's a loop function, but I can't seem to get it to work as I want.
One other consideration to note: it takes 3-5 minutes per report to refresh all the data, generate the report and save it. I'd like to set this to run before I leave at night and have it done in the morning.
Thanks in advance.
Aaron
I think this may be what you are looking for.
Dim DataValidationRange As Range
Dim Str As String
Str = Replace(Range("B1").Validation.Formula1, "=", "")
Set DataValidationRange = Range(Str)
Dim i
For Each i In DataValidationRange
Range("B1").Value = i
Call AA_RunAll
Next
Also if you need to wait for the data to update before calling AA_RunAll, you could use this:
Public Function MyTimer(MyDelay As Double)
Dim MyTimerTimer As Double
MyTimerTimer = Timer
MyDelay = MyDelay + Timer
Do While MyTimerTimer <= MyDelay
MyTimerTimer = Timer
DoEvents
Loop
End Function
Private Sub GoThrough_Dropdown()
Dim DataValidationRange As Range
Dim Str As String
Str = Replace(Range("B1").Validation.Formula1, "=", "")
Set DataValidationRange = Range(Str)
Dim i
For Each i In DataValidationRange
Range("B1").Value = i
WaitForDataToUpdate
Call AA_RunAll
Next
End Sub
Private Sub WaitForDataToUpdate()
Dim RangeToWaitFor As Range
Set RangeToWaitFor = Range("H5")
Dim Str As String
Str = RangeToWaitFor.Value
Do While Str = RangeToWaitFor.Value
MyTimer 1
Loop
End Sub
I've got a URL like this:
http://www.xyz342.net/abc/date_from=24.05.2018 00:00:00&date_to=24.05.2018 00:00:00&abc=2
I've used the following vba code to extract the table into excel:
Sub GetWebTable()
With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.xyz342.net/abc/date_from=24.05.2018 00:00:00&date_to=24.05.2018 00:00:00&abc=2", Destination:=Range("a1"))
.Refresh BackgroundQuery:=False
.SaveData = True
End With
End Sub
Task: I want to extract the table for each day of 2018 automatically until today. Therefore the date in that above given URL has to be changed every time (e.g. http://www.xyz342.net/abc/date_from=20.09.2018 00:00:00&date_to=20.09.2018 00:00:00&abc=2 gives the table for 20.09.2018). How can I do that?
Perfect would be a new worksheet for each day. Every future day should be automatically added.
This should give you some ideas in terms of generating the dates in a loop and concatenating into the URL the current date. It also demonstrates how to add new sheets.
I think there are likely better scraping methods than generating queryTables like this. If you can share HTML for one link (And the lay out is the same for each day) it may be possible to devise a much better approach.
Following on from #Marcucciby2's comment you might also get startdate with something like: startDate = DateSerial(YEAR(Date), 1, 1)
Unless the historic tables are refreshed then you probably only want to run the below once. Then remove the loop and simply have the date generated from dateString = Format$(Date, "dd.mm.yyyy"), or Date-1 to get the prior day. You mention wanting it to be added automatically; You could tie to a change event that is linked to a cell where you select a date from a drop down.
Option Explicit
Public Sub test()
Dim url As String, startDate As Long, endDate As Long, i As Long, dateString As String
startDate = DateValue("2018-01-01")
endDate = CLng(Date)
For i = startDate To endDate
DoEvents
dateString = Format$(i, "dd.mm.yyyy")
url = "http://www.xyz342.net/abc/date_from=" & dateString & " 00:00:00&date_to=" & dateString & " 00:00:00&abc=2"
AddQueryTable url, dateString
Next
End Sub
Public Sub AddQueryTable(ByVal url As String, ByVal dateString As String)
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets.Add
ws.NAME = dateString
On Error Resume Next
With ws.QueryTables.Add(Connection:="URL;" & url, Destination:=ws.Range("a1"))
.Refresh BackgroundQuery:=False
.SaveData = True
End With
On Error GoTo 0
End Sub
In the aim to allow users from different countries to use my application, I would like to initialize a translation of each object in each existing userform (labels,commandbuttons,msgbox,frames, etc...) at the start of the application.
I'll write all the translation in my Languages sheet:
I've already made a first userform where the user types his login, password and selects his language.
After this step, the main userform called "Menu" will be launched.
I've already tried to type a piece of code (here below) to find the line of code, in a msgbox that I want to run (example : menu.commandbutton1.caption="Envoyer email")
Private Sub UserForm_Initialize()
' Definition of language selected during login
Set langue = Sheets("Languages").Cells.Find("chosen",
lookat:=xlWhole).Offset(-1, 0)
' Initialisation of the texts in the selected language
Dim cel As Range
Dim action As String
For Each cel In Sheets("Languages").Range("d3:d999")
If cel <> "" Then
action = cel & "=" & """" & cel.Offset(0, -2) & """"
MsgBox (action)
End If
Next cel
End Sub
I've already read some topics about this subject but those does not correspond exactly to what i would like to do.
If you have a solution, or a work around, it would be very helpful.
If you simply want different MsgBox, based on a coutry, this is probably the easiest way to achieve it. Imagine your file is like this:
Then something as easy as this would allow you to use different strings, based on the country:
Public Sub TestMe()
Dim country As String
Dim language As Long
country = "Bulgaria" 'or write "England" to see the difference
language = WorksheetFunction.Match(country, Range("A1:B1"), 0)
MsgBox (Cells(2, language))
MsgBox "The capital of " & country & " is " & (Cells(3, language))
End Sub
The idea of the whole trick is simply to pass the correct column, which is done through WorksheetFunction.Match.
Taken from an old CR post I have here, this solution pretty much mimicks .NET .resx resource files, and you can easily see how to extend it to other languages, and if I were to write it today I'd probably use Index+Match lookups instead of that rather inefficient loop - but anyway it works nicely:
Resources standard module
Option Explicit
Public Enum Culture
EN_US = 1033
EN_UK = 2057
EN_CA = 4105
FR_FR = 1036
FR_CA = 3084
End Enum
Private resourceSheet As Worksheet
Public Sub Initialize()
Dim languageCode As String
Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)
Case Culture.EN_CA, Culture.EN_UK, Culture.EN_US:
languageCode = "EN"
Case Culture.FR_CA, Culture.FR_FR:
languageCode = "FR"
Case Else:
languageCode = "EN"
End Select
Set resourceSheet = Worksheets("Resources." & languageCode)
End Sub
Public Function GetResourceString(ByVal resourceName As String) As String
Dim resxTable As ListObject
If resourceSheet Is Nothing Then Initialize
Set resxTable = resourceSheet.ListObjects(1)
Dim i As Long
For i = 1 To resxTable.ListRows.Count
Dim lookup As String
lookup = resxTable.Range(i + 1, 1)
If lookup = resourceName Then
GetResourceString = resxTable.Range(i + 1, 2)
Exit Function
End If
Next
End Function
The idea is, similar to .NET .resx files, to have one worksheet per language, named e.g. Resources.EN and Resources.FR.
Each sheet contains a single ListObject / "table", and can (should) be hidden. The columns are basically Key and Value, so your data would look like this on sheet Resources.EN:
Key Value
menu.caption Menu
menu.commandbutton1.caption Send email
menu.commandbutton1.controltiptext Click to send the document
And the Resources.FR sheet would have a similar table, with identical keys and language-specific values.
I'd warmly recommend to use more descriptive names though; e.g. instead of menu.commandbutton1.caption, I'd call it SendMailButtonText, and instead of menu.commandbutton1.controltiptext, I'd call it SendMailButtonTooltip. And if your button is actually named CommandButton1, go ahead and name it SendMailButton - and thank yourself later.
Your code can then "localize" your UI like this:
SendMailButton.Caption = GetResourceString("SendMailButtonText")
The Resources.Initialize procedure takes care of knowing which resource sheet to use, based on Application.LanguageSettings.LanguageID(msoLanguageIDUI) - and falls back to EN, so if a user has an unsupported language, you're still showing something.
I've tried almost everything in most of the other similar type questions but I can't seem to solve the runtime error. Help please!
What I want to achieve:
1) My macro is supposed to get date from report summary files that are created every day hence, it requires the user to input which date of report he wants the data from
2) I use the vlookup method to get the data from the relevant row and input it into the central workbook with the macro
3) Every part of the code works except using the date to Vlookup and it will give me this error message
4) I have tested the code using other text based lookup values and the whole macro works (i.e. i looked up the row which has the "Total" value so it looks up "Total" but i require the macro to look up the rows with the date as the look up value)
Addtional Info:
1) In the lookup file, the dates are in the format of "m/d/yyyy" but presented in the format of "dd-mmm-yy" (but i've tried both and they dont work)
Sub GetData()
Dim strDate As Date
strDate = InputBox("Input date of report to retrieve (Format: DD-MM-YYYY)", "Input Date", Format(Now(), "DD-MM-YYYY"))
If IsDate(strDate) Then
'there is some code here not relevant but basically i need to keep manipulating the date throughout the code
With ActiveSheet
Dim XstrDate
Dim Xfile As String
XstrDate = Format(strDate, "mmm DD, YYYY")
Xfile = "C:\...\...\...\Report " & XstrDate & ".xls"
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim returnValue as Variant
Set wb = Application.Workbooks.Open(Xfile)
Set ws = wb.Worksheets("Summary")
Set rng = ws.Range("A:K")
Dim Xdate As String
Xdate = Format(XstrDate, "m/d/yyyy")
returnValue = Application.WorksheetFunction.VLookup(Xdate, rng, 2, 0)
'... more code
remember, i've tried looking up using the text in the same column and it returned me a value. So i suspect the problem lies with the date format or something
Any smart and kind soul want to offer some suggestions here:)
Excel internally stores dates as a Serial Number (e.g. 1/1/2014 = 41640), which you can observe yourself if you enter a date into a cell and then change the format to Number.
With this in mind it's unlikely that a VBA date and an Excel date can be matched using the VLookup function so in my experience the best solution is to convert your date into its serial number and then perform the VLookup on that value instead.
Dim Ndate As Long
Dim returnValue As Date
Ndate = DateSerial(<Year>, <Month>, <Day>)
returnValue = Application.WorksheetFunction.VLookup(Ndate, <rng>, <col>, False)
If you need to construct your DateSerial(...) function from a Date variable in VBA you can use the Year(<date>), Month(<date>), and Day(<date>) functions to break it down into the required components.
Note: I've tried this example in the format .VLookup(DateSerial(2014,1,1),...) and it still causes the same error, hence storing the return value of DateSerial in a numeric variable first.
Happy Coding!
I've taken a different approach and found another solution to this problem.
Rather than use Vlookup, this is the other method that bypass the problem of VLookup date format problem, (having defined vdate in previous statements)
Dim rnge As Range, i As Long
Sheets("Summary").Select
Columns("A:A").Select
Set rnge = Intersect(Selection, ActiveSheet.UsedRange)
If rnge Is Nothing Then
MsgBox "Date Not Found"
GoTo done
End If
For i = rnge.Count To 1 Step -1
If rnge.Cells(i).Value = vdate Then rnge.Cells(i).EntireRow.Copy _
Destination:=ThisWorkbook.Sheets("AnotherSheet").Range("A1")
Next
done:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
I'm looking for an elegant solution to trigger an event for opening the workbook as well as opening different worksheets. I don't need seperate operations for each worksheet: they all trigger the same method.
I know I can use the events Workbook_Activate / Workbook_Open and Workbook_SheetActivate at the same time but I don't know if this is 'the official way' to do it. Perhaps there's a way to do this with one event.
I was also wondering if it is relevant in this matter where I put the code. I now have all the code inside "ThisWorkbook" and not in a "Module"...
Here is some code I developed a while ago to ensure that a report my managers use is always opened to the correct tab based on time of day. I house this code in the "ThisWorkbook" module of my VBA.
Sub Workbook_Open()
' Set The Office
Dim begin As String
Dim myNum As String
Dim myNum1 As String
Dim TheDate As String
' Set Date
TheDate = Format(DateTime.Now(), "mm-dd-yy")
Sheets("MORNING").Range("H3").Value = TheDate
Sheets("AFTERNOON").Range("G3").Value = TheDate
'Sheets("EVENING").Range("G3").Value = TheDate
' Select Sheet Based on Time of Day
If Time >= 0.1 And Time < 0.5 Then
Sheets("MORNING").Select
Range("A53").Value = "Report completed by:"
Range("C53").Value = Application.UserName
Range("I53").Value = Date & " " & Time
Range("B27").Select
Call Populate 'Your next code
ElseIf Time >= 0.5 And Time < 0.75 Then
Sheets("AFTERNOON").Select
Range("A54").Value = "Report completed by:"
Range("C54").Value = Application.UserName
Range("I54").Value = Date & " " & Time
Range("C28").Select
Call Populate 'Your next code
End If
End Sub
Notice that I have also added code to auto sign the form output with the userid and update date and time. I hope this helps.
Like others have mentioned: there's no single event to do this. There might be workarounds, but I prefer just using _Open and _SheetActive in that case. Thanks everyone!