I'm working on a simple Outlook VBA script to accept all selected meeting requests. Many online examples suggest something like the following code should work:
Sub AcceptItem()
Dim cAppt As AppointmentItem
Dim oRequest As MeetingItem
Dim x As Integer
For x = Application.ActiveWindow.Selection.Count To 1 Step -1
If (Application.ActiveWindow.Selection.Item(x).MessageClass = "IPM.Schedule.Meeting.Request") Then
Set cAppt = Application.ActiveWindow.Selection.Item(x).GetAssociatedAppointment(True)
Set oRequest = cAppt.Respond(olMeetingAccepted, True)
oRequest.Send
End If
Next x
End Sub
But the script always fails at oRequest.send -- when I inspect with the debugger, oRequest is always set to Nothing after the Respond line is executed, rather than containing a MeetingItem.
What am I doing wrong?
Before calling the Respond method in the code you need to check the AppointmentItem.ResponseRequested property which returns a boolean that indicates true if the sender would like a response to the meeting request for the appointment.
For x = Application.ActiveWindow.Selection.Count To 1 Step -1
If (Application.ActiveWindow.Selection.Item(x).MessageClass = "IPM.Schedule.Meeting.Request") Then
Set cAppt = Application.ActiveWindow.Selection.Item(x).GetAssociatedAppointment(True)
If cAppt.ResponseRequested = True Then
Set oRequest = cAppt.Respond(olMeetingAccepted, True)
oRequest.Send
End If
End If
Next x
Related
I'm trying to update various fund sizes using morgninstar.co.uk. The code worked fine until it suddenly stopped and gave an error:
"Run-time error 424: Object required".
The exact line where the error occurs is:
Set allData = IE.document.getElementById("overviewQuickstatsDiv").getElementsByTagName("tbody")(0)
The idea is to ultimately scan the whole "tbody"-tag and look for the line "Fund Size" inside "tr" and "td"-tags. When "Fund Size" is found, the code would return the 3rd "td"-tag (actual fund size).
After this I'd add a loop to loop through a list of funds that I've got.
As the code stopped working completely, I haven't got this far yet. Here I'm just trying to check if the code returns the actual fund size.
Since there are not always 3 "td"-tags inside the "tr"-tags, I'll still have to construct some sort of IF-statement to fix that issue.
But for now I'd just want to know how I could get the code running again? I've spent great deal of time searching for an answer but as it seems that this is a variable type problem the solution depends on the situation.
I'm using Excel 2010 and Internet Explorer 11.
URL in easy form to copy-paste:
http://www.morningstar.co.uk/uk/funds/snapshot/snapshot.aspx?id=F0GBR04BKW
Sub testToScrapeWholeTbodyTag()
'Microsoft Internet Controls
'Microsoft HTML Object Library
'Microsoft Shell Controls and Automation
'======Opens URL======
Dim IE As Object
Set IE = CreateObject("internetexplorer.application")
With IE
.navigate "http://www.morningstar.co.uk/uk/funds/snapshot/snapshot.aspx?id=F0GBR04BKW"
.Visible = False
End With
While IE.Busy
DoEvents
Wend
'======Got from internet, fixed a previous error. However, I'm not 100% sure what this does======
Dim sh
Dim eachIE As Object
Do
Set sh = New Shell32.Shell
For Each eachIE In sh.Windows
If InStr(1, eachIE.LocationURL, "http://www.morningstar.co.uk/uk/funds/snapshot/snapshot.aspx?id=F0GBR04BKW") Then
Set IE = eachIE
IE.Visible = False '"This is here because in some environments, the new process defaults to Visible."
Exit Do
End If
Next eachIE
Loop
Set eachIE = Nothing
Set sh = Nothing
'======Looks for the "Fund Size"======
'Trying to look for "Fund Size" inside "tr"-tag and if found, return the value in the 3rd "tr"-tag
Set allData = IE.document.getElementById("overviewQuickstatsDiv").getElementsByTagName("tbody")(0) 'Run-time error 424: Object required
row1 = allData.getElementsByTagName("tr")(5).Cells(0).innerHTML
row2 = allData.getElementsByTagName("tr")(5).Cells(1).innerHTML
row3 = allData.getElementsByTagName("tr")(5).Cells(2).innerHTML
If Left(row1, 9) = "Fund Size" Then
Worksheets("Sheet3").Range("B3") = Split(row3, ";")(1)
End If
Debug.Print allData.getElementsByTagName("tr")(5).Cells(0).innerHTML '"Fund Size"
Debug.Print allData.getElementsByTagName("tr")(5).Cells(2).innerHTML 'Actual fund size
IE.Quit
Set IE = Nothing
End Sub
EDIT:
Switched method. Now the problem is to get the fund size extracted. So the below code works as it is but I'd need to add a couple of lines to get the fund size out of it. This is my first time using this method so it may well be that I've just not understood some really basic thing. Still, I wasn't able to find a solution to this on my own.
Sub XMLhttpRequestTest()
'Microsoft XML, v 6.0
'Microsoft HTML object library
Dim HTMLDoc As New HTMLDocument
Dim ohttp As New MSXML2.XMLHTTP60
Dim myurl As String
Dim TRelements As Object
Dim TRelement As Object
myurl = "http://www.morningstar.co.uk/uk/funds/snapshot/snapshot.aspx?id=F0GBR04BKW"
ohttp.Open "GET", myurl, False
ohttp.send
HTMLDoc.body.innerHTML = ohttp.responseText
With HTMLDoc.body
Set TRelements = .getElementsByTagName("tr")
For Each TRelement In TRelements
Debug.Print TRelement.innerText
Next
End With
End Sub
You can use a css selector of
#overviewQuickstatsDiv td.line.text
And then select the element at index 4
# means id. . = className.
Option Explicit
Public Sub XMLhttpRequestTest()
'Microsoft XML, v 6.0
'Microsoft HTML object library
Dim HTMLDoc As New HTMLDocument, ohttp As New MSXML2.XMLHTTP60
Const URL As String = "http://www.morningstar.co.uk/uk/funds/snapshot/snapshot.aspx?id=F0GBR04BKW"
Dim TRelements As Object, TRelement As Object
With ohttp
.Open "GET", URL, False
.send
HTMLDoc.body.innerHTML = .responseText
Debug.Print HTMLDoc.querySelectorAll("#overviewQuickstatsDiv td.line.text")(4).innerText
'Your other stuff
End With
End Sub
I'm brand spanking new to VBA. But I've programmed a bit in SAS, just a bit in Assembler (mainframe and PC), Word Perfect (macros), a bit in Java, HTML, other stuff. What I do is, when I have a problem and I think I can program it, I look for code on the internet and adjust it to fit my needs. I have read a little bit of VBA programming. What I'm trying to do is make a macro to save a bunch of Outlook e-mail messages with PDFMAKER. I've come up with the below, so far. When I step the program, pmkr2 gets assigned type "ObjectPDFMaker" and stng gets assigned type "ISettings". So far, so good. Then I try to set stng and can't do it. I get the error "Method or data member not found." If I get rid of Set it highlights .ISettings and I get the same error. I go into F2 and the AdobePDFMakerforOffice library is there, and the class ISettings is there, but I can't seem to set stng. I'm wa-a-a-ay frustrated. Please help.
Sub ConvertToPDFWithLinks()
Dim pmkr2 As Object
Set pmkr2 = Application.COMAddIns.Item(6).Object ' Assign object reference.
Dim pdfname As String
pdfname = "C:\stuff\stuff\tester.pdf"
Dim stng As AdobePDFMakerForOffice.ISettings
Set stng = AdobePDFMakerForOffice.ISettings
stng.AddBookmarks = True
stng.AddLinks = True
stng.AddTags = True
stng.ConvertAllPages = True
stng.CreateFootnoteLinks = True
stng.CreateXrefLinks = True
stng.OutputPDFFileName = pdfname
stng.PromptForPDFFilename = False
stng.ShouldShowProgressDialog = True
stng.ViewPDFFile = False
pmkr.GetCurrentConversionSettings stng
pmkr2.CreatePDFEx stng, 0
Set pmkr2 = Nothing ' Discontinue association.
End Sub
I updated your code a little. See if this has any affect:
Sub ConvertToPDFWithLinks()
Dim pmkr2 As AdobePDFMakerForOffice.PDFMaker
'Set pmkr2 = Application.COMAddIns.Item(6).Object ' Assign object reference.
Set pmkr2 = Nothing
For Each a In Application.COMAddIns
If InStr(UCase(a.Description), "PDFMAKER") > 0 Then
Set pmkr2 = a.Object
Exit For
End If
Next
If pmkr2 Is Nothing Then
MsgBox "Cannot Find PDFMaker add-in", vbOKOnly, ""
Exit Sub
End If
Dim pdfname As String
pdfname = "C:\stuff\stuff\tester.pdf"
Dim stng As AdobePDFMakerForOffice.ISettings
pmkr2.GetCurrentConversionSettings stng
stng.AddBookmarks = True
stng.AddLinks = True
stng.AddTags = True
stng.ConvertAllPages = True
stng.CreateFootnoteLinks = True
stng.CreateXrefLinks = True
stng.OutputPDFFileName = pdfname
stng.PromptForPDFFilename = False
stng.ShouldShowProgressDialog = True
stng.ViewPDFFile = False
pmkr2.CreatePDFEx stng, 0
Set pmkr2 = Nothing ' Discontinue association.
End Sub
The main changes were in how the addin is obtained and in how stng is created.
I want to accept or tentatively accept meeting requests in Outlook, depending on whether I have a meeting at that time. I've got the rule set up; it runs the VBA as far as I know, but the code isn't working. I can't find the issue with it.
Sub AcceptDecline(oRequest As MeetingItem)
If oRequest.MessageClass <> "IPM.Schedule.Meeting.Request" Then
Exit Sub 'if this messageclass isn't a meeting request
End If
Dim oAppt As AppointmentItem
Set oAppt = oRequest.GetAssociatedAppointment(True)
Dim myAcct As Outlook.Recipient
Dim myFB As String
Set myAcct = Session.CreateRecipient("roconnor#pattonair.com")
myFB = myAcct.FreeBusy(oAppt.Start, 5, False) 'gets the free or busy status of my calendar
Dim oResponse
Dim i As Long
Dim test As String
i = (TimeValue(oAppt.Start) * 288)
test = Mid(myFB, i - 2, (oAppt.Duration / 5) + 2)
If InStr(1, test, "1") Then
Set oResponse = oAppt.Respond(olMeetingTentative, True)
oResponse.Display
oResponse.Send
Else
Set oResponse = oAppt.Respond(olMeetingAccepted, True)
oResponse.Display
oResponse.Send
End If
End Sub
If the meeting request automatically creates a meeting that is tentatively accepted then free busy indicates you are busy. The response will always be tentative accept.
File-> Options-> Mail-> Tracking-> disable: Automatically process meeting requests and responses to meeting requests and polls
https://www.msoutlook.info/question/do-not-automatically-accept-meeting-as-tentative
If that is not the problem then open the request, which is not automatically marked tentative, and step through with:
Private Sub AcceptDecline_test()
AcceptDecline ActiveInspector.currentItem
End Sub
I am totally new in VBA and coding in general,
i want to attache a pdf (Print.pdf) to a specific field (alias_3) in a lotus notes database but i am getting the error 424.
Any suggestions what i am doing incorrectly?
Sub aa()
Dim alias_3 As String
Set notesface = CreateObject("Notes.NotesSession")
Set makeup = Nothing
Set makeup = notesface.GetDatabase("C2S2/ConsolidatedContracts", "p_dir\bpcmrtuat.nsf")
Set docu = makeup.GetDocumentByID("00002BE6")
Attachment1 = "C:\Users\Desktop\aloxa\Print.pdf"
rtitem = docu.HasEmbedded
For Each test2 In docu.GetItemValue("alias_3")
test = test2.HasEmbedded ----> here i am getting the error
Set EmbedObj1 = docu.alias_3.embedobject(1454, "attachment1", Attachment1, "")
Exit For
Next test2
Set EmbedObj1 = test.embedobject(1454, "", Attachment1, "")
Set AttachME = test.CreateRichTextItem("attachment1")
docu.GetItemValue ("alias_3")
If Attachment1 <> "" Then
Set AttachME = docu.CreateRichTextItem("Attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", Attachment, "")
On Error GoTo 0
End If
ExitSub:
End Sub
According to the Lotus Note documentation, GetItemValue() returns either a String, an array of String, or an array of Doubles, none of them having a HasEmbedded property.
Your codes mixes getting values from an item with attaching things to another item, etc.
First of all: Do you REALLY have a richtextitem called "alias_3" in the design of the form that your document is made of? Or is the name of the item "Attachment1" as in your second part of the code? Or is it a default mail database, then the name of the item would be "Body"?
Just replace "alias_3" in the following code with the appropriate itemname. The complete code can be reduced to these lines (I replaced the variable names, so that another developer KNOWS what you mean by using "defaults"):
Set ses = CreateObject("Notes.NotesSession")
Set db = ses.GetDatabase("C2S2/ConsolidatedContracts", "p_dir\bpcmrtuat.nsf")
Set doc = db.GetDocumentByID("00002BE6") '- This line is dangerous, because the noteid can change easily...
strAttachmentPath = "C:\Users\Desktop\aloxa\Print.pdf"
Set rtItem = doc.GetFirstItem( "alias_3" )
If not rtItem.HasEmbedded() then
Call rtItem.embedobject(1454, "", strAttachmentPath , "")
Else
'- what do you want to do, if there is already an embedded attachment?
End if
Call doc.Save( True, True, True )
I have a fairly straightforward VBA script that accepts meeting requests in Outlook (2013). It works fine most of the times, but for some meeting requests it gives me "object variable or with block variable not set" on this line
Set oResponse = oAppt.Respond(olMeetingAccepted, True)
I've tried to look at the different meeting requests to figure out any differences which might be triggering it but for all purposes they look like identical requests (of course they're from different senders with different subject and time, but nothing that I can see as triggering a fail).
Any thoughts what might be going on? Here's the complete Sub (it gets triggered by an outlook rule)
Sub AutoAcceptMeetings(oRequest As MeetingItem)
Dim senderName As String
Dim subjectName As String
Dim meetingTime As String
Dim senderContains As Integer
Dim subjectContains As Integer
Dim oResponse As MeetingItem
Dim oAppt As AppointmentItem
On Error GoTo debugs
If oRequest.MessageClass <> "IPM.Schedule.Meeting.Request" Then
Exit Sub
End If
Set oAppt = oRequest.GetAssociatedAppointment(True)
senderName = oRequest.senderName
subjectName = oRequest.Subject
senderContains = InStr(1, senderName, "Gina")
'Her meeting invitations don't have a reminder set.
If (senderContains > 0) Then
oAppt.ReminderSet = True
oAppt.ReminderMinutesBeforeStart = 15
End If
senderContains = InStr(1, senderName, "Jim")
If (senderContains > 0) Then 'I don't want a reminder
oAppt.ReminderSet = False
oAppt.BusyStatus = olTentative
oAppt.Save
Else 'useful meetings. accept and send response.
meetingTime = oAppt.Start
Set oResponse = oAppt.Respond(olMeetingAccepted, True)
oResponse.Send
MsgBox ("Meeting accepted " + subjectName + " from " + senderName + " for " + meetingTime)
End If
debugs:
If Err.Description <> "" Then MsgBox (Err.Description + " - Source: AutoAcceptMeetings")
End Sub
So, the issue was that I was trying to send a "response" to a meeting request that didn't require any responses. On the front end (outlook) if you accept the meeting, it goes into your calendar and the request gets deleted but no response goes to the organizer (people do that when they invite a large group and don't necessarily care to know who's attending).
Anyway, the solution for me was to put in a simple check before actually responding to the request.
If (oAppt.ResponseRequested) Then
Set oResponse = oAppt.Respond(olMeetingAccepted, True)
oResponse.Send
End If