I get the follow error from the click line: "Microsoft Excel is waiting for another application to complete an OLE action." How can I solve this? Thanks for your help.
It really annoys me becuase I can't even get the program to stop running, even by pressing several combinations of escape keys, so I have to restart my computer.
Set objCollection = IE.document.getElementsByTagName("a")
i = 0
While i < objCollection.Length
If objCollection(i).Title = "The maximum amount of records that may be downloaded is 2,000." Then
Set objElement = objCollection(i)
End If
i = i + 1
Wend
objElement.Click
Better to use a "For each" to browse through all of the anchors:
Dim objCollection, obj
For each obj in objCollection
If obj.Title = "The maximum amount of records that may be downloaded is 2,000." Then
Set objElement = obj
Exit For
End If
Next obj
I'm assuming there will only be the one result that you are looking for which is why i included the exit clause. This is quite vital as you don;t want the code to continue executing after it has found what you are after...
Related
Settings
PowerPoint 2016
.NET com-addin (CP 4) with
WindowActivate DISPID(2009)
for test purposes changed to just "do nothing but the necessities"
Windows 10
Create an empty file in a folder using windows explorer (no slides
inside said file).
Problem description
Using integrated VBA i ran this code three times
Option Explicit
Sub test()
Dim objPresentation As PowerPoint.Presentation
Set objPresentation = Application.Presentations.Open("c:\test\folder\file.pptx")
objPresentation.Close
Set objPresentation = Nothing
Debug.Print Presentations.Count
For Each objPresentation In Presentations
Debug.Print objPresentation.FullName, vbTab, objPresentation.Windows.Count
Next
End Sub
Please find result below
2
C:\Users\admin\Desktop\kh_tests.pptm 1
c:\test\folder\file.pptx 0
3
C:\Users\admin\Desktop\kh_tests.pptm 1
c:\test\folder\file.pptx 0
c:\test\folder\file.pptx 0
4
C:\Users\admin\Desktop\kh_tests.pptm 1
c:\test\folder\file.pptx 0
c:\test\folder\file.pptx 0
c:\test\folder\file.pptx 0
It confuses not only my addin (is a presentation open or not), it seems not to be intentional since one could expect ppt would at least reuse the entry it left behind last time, but the entry seems to be corrupt.
I've encountered this behavior on several systems with PPT2016.
PPT2010 does not show this behavior.
Thank you for reading
KH
Explanation/Hypothesis
I think i came closer to the reason (sorry for the time it took but you know how it is some times); i came to the believe that "someone" is still pointing to that particular presentation so it might not close; so i decided to have another go for it.
I narrowed it down by selective disabling everything in my com-addin, but to no result: even doing nothing (just "return") the behavior remains the same; but if i did not connect my connection-point (WindowActivate, DISPID 2009) in the first place it suddenly worked and all went well. According to my logfile the event has always been processed after the close, not interfering with anything, but who knows. I tried to force things with DoEvents, but to no avail.
Hypothesis:
The presence of WindowActivate event sinks will keep PowerPoint2016 from discarding the presentation WHICH HAS BEEN ACTIVE at that time, even if closing this presentation is the reason for the event in the first place.
Test:
Unfortunately i found no easy way to have an vba/inapp test. Any ideas?
But with my fully fledged com addin present (okay, still much deactivated, by sink connected), i tested this:
Option Explicit
Dim objCloak As PowerPoint.Presentation
Sub test()
Dim objPresentation As PowerPoint.Presentation
Set objPresentation = Application.Presentations.Open("C:\test\folder\file.pptx")
If objCloak Is Nothing Then
Set objCloak = Presentations.Add ' change to the intermediate presentation
End If
DoEvents ' relic from previous tests
objCloak.Windows(1).Activate ' ' be paranoid
DoEvents ' relic from previous tests
objPresentation.Close
DoEvents ' relic from previous tests
If (Not (Nothing Is objCloak)) Then
objCloak.Saved = True
objCloak.Close
End If
Set objCloak = Nothing
For Each objPresentation In Presentations
Debug.Print objPresentation.FullName, vbTab, objPresentation.Windows.Count
Next
End Sub
And the result is
C:\Users\admin\Desktop\kh_tests.pptm 1
C:\Users\admin\Desktop\kh_tests.pptm 1
C:\Users\admin\Desktop\kh_tests.pptm 1
Switch back and force between the two variants yields the results as described above. So i think there's something here.
Note: the PowerPoint Task now closes without any problems.
I understand there have been answered for similar questions but I am not sure if I could not understand how to approach to the solutions from other people' answers or my the website I need to get the information from is complex. So, please help me.
I would like to get the description field from Delphi for PN#13511996, the value should be "3 Way Gray GT 150 Sealed Female Connector Assembly, Max Current 15 amps" . Could someone help me examine the website and let me know how to get the description?
Sub GetData()
'Added Microsoft HTML Object library to reff
'Added Microsoft XML, v6.0 to reff
Dim xhr As MSXML2.XMLHTTP60
Dim doc As MSHTML.HTMLDocument
Dim desc As String
Set xhr = New MSXML2.XMLHTTP60
With xhr
.Open "GET", "http://ecat.delphi.com/feature?search=13511996", False
.send
If .ReadyState = 4 And .Status = 200 Then
Set doc = New MSHTML.HTMLDocument
doc.body.innerHTML = .responseText
End If
End With
With doc
desc = .getElementsByClassName("ProductDetail.Description").Item(0).innerText
End With
Debug.Print desc
End Sub
This is because you are requesting raw HTML by using GET from XMLHTTP. If you try to Debug.Print doc.body.innerHTML, you will see that the table has not been generated yet, and the text you are looking for is not there at all.
To be able to run the query for item "13511996", you need a real browser. Only then you can generate your table and get DOM document object. Try the following code:
Sub GetData()
Dim aIE As InternetExplorer
Dim desc As IHTMLElement
Set aIE = New InternetExplorer
With aIE
.navigate "http://ecat.delphi.com/feature?search=13511996"
.Visible = True '----> set it to false if you dont want to see the browser
End With
Do While (aIE.Busy Or aIE.ReadyState <> READYSTATE_COMPLETE)
DoEvents
Loop
Set desc = aIE.document.getElementsByClassName("DetailAttributes")(0)
'Debug.Print desc.innerText '---> prints the whole table data
Debug.Print Split(desc.innerText, vbLf)(3) '----> prints the forth data in table
Set aIE = Nothing
Set desc = Nothing
End Sub
And also if you plan to automate this code to run in a loop for multiple queries, you might want to use:
Set desc = Nothing
For i = 1 To 100
On Error Resume Next
Set desc = aIE.document.getElementsByClassName("DetailAttributes")(0)
If Err.Number = 91 Then
GoTo Skip
End If
Exit For
Skip:
Application.Wait (Now() + TimeValue("00:00:001"))
Next i
instead of:
Set desc = aIE.document.getElementsByClassName("DetailAttributes")(0)
This is because sometimes web page seems ready before it fully generates its contents. This causes the code to get out of do loop and proceed to next statement which sets desc object. You won't get an error while setting it because the code will be using previous DOM document object and will be outputting the results of your previous query, which is a bug. Without any errors, your code will run the loop till the end, and you will have a completely twisted output in your hand, which is a waste of time.
To work around this problem, you should set the object to nothing beforehand, and catch the error and wait for the page to load in for loop.
Last but not least, if the guys who build the web page that you are parsing are aware of what they are doing, they will probably protect it from multiple queries from the same source (most likely from multiple sources as well), which might cause their server to collapse if they don't. This protection will be reflected to you as limited number of queries within a limited amount of time. In other words, for example after 100 request within 5 minutes, the web page will not be responding for sometime (for example 2 minutes).
To workaround this problem, you should limit the number of requests and wait for the required time. Suppose that you increment your loop with i variable. Then you need to insert this at the end of your loop:
If i Mod 100 = 0 Then
Application.Wait (Now() + TimeValue("00:02:00"))
End If
I hope the above mentioned solutions solve everyone's past and future problems, which took me a considerable amount of time to figure out.
I'm using MS-Access 2010 and Autocad 2012 64bit and work in manufacturing.
I want to be able to at the very least, populate fields in a title block, better still I would like to use data in my access database to write data into a sheet set (the current system works by reading the sheet set values such as sheet title and number into my title block).
The following code is all I have at the moment and it will open autocad and write the date into the command line.
Private Sub OpenAutocad_Click()
Dim CadApp As AcadApplication
Dim CadDoc As AutoCAD.AcadDocument
On Error Resume Next
Set CadApp = GetObject(, "AutoCAD.Application")
If Err.Number <> 0 Then
Set CadApp = CreateObject("AutoCAD.Application")
End If
On Error GoTo 0
CadApp.Visible = True
CadApp.WindowState = acMax
Set CadDoc = CadApp.ActiveDocument
CadDoc.Utility.Prompt "Hello from Access, the time is: " & TheTime
Set CadApp = Nothing
End Sub
I have no idea where to go from here. What are the commands to control the sheet set manager and change data, and can the .dst file be edited without even opening up autocad? is there a list of all available autocad vba commands and functions?
If you are declaring CadApp as AcadApplication you must have added a reference to AutoCAD.
That means you should be able to see the object model using your Object Browser in your VBA IDE. No?
There is also a very helpful site www.theswamp.org which has a whole section devoted to AutoCAD VBA.
If I understand your question correctly, you want to automate filling attributes in a drawing title blocks (such as title, drawer, part number, etc) right from MS Access.
Your code can access the Autocad command line already, but Autocad doesn't seem to have the exact command for filling drawing attribute. (command list)
So looks like you need to fill the attributes programatically using the COM API.
The following question appears to be relevant with yours and the accepted answers does provide a sample code:
Is it possible to edit block attributes in AutoCAD using Autodesk.AutoCAD.Interop?
Note that in that question the asker was developing a standalone application in C# .NET, where as you will be using VB Automation from MS Access. Shouldn't be too different since the Component Object Model (COM) being used is the same.
What are the commands to control the sheet set manager and change data and can the .dst file be edited without even opening up autocad?
(sorry can't post more than 2 links)
docs.autodesk.com/ACD/2010/ENU/AutoCAD%202010%20User%20Documentation/files/WS1a9193826455f5ffa23ce210c4a30acaf-7470.htm
No mention about data change, though.
is there a list of all available autocad vba commands and functions?
Yes.
%ProgramFiles%\Common Files\Autodesk Shared\acad_aag.chm - Developer's Guide
%ProgramFiles%\Common Files\Autodesk Shared\acadauto.chm - Reference Guide
Online version:
help.autodesk.com/cloudhelp/2015/ENU/AutoCAD-ActiveX/files/GUID-36BF58F3-537D-4B59-BEFE-2D0FEF5A4443.htm
help.autodesk.com/cloudhelp/2015/ENU/AutoCAD-ActiveX/files/GUID-5D302758-ED3F-4062-A254-FB57BAB01C44.htm
More references here:
http://usa.autodesk.com/adsk/servlet/index?id=1911627&siteID=123112
:) Half the way gone ;)
If you has a open autocad with a loaded drawing you can access the whole thing directly.
Sub block_set_attribute(blo As AcadBlockReference, tagname, tagvalue)
Dim ATTLIST As Variant
If blo Is Nothing Then Exit Sub
If blo.hasattributes Then
tagname = Trim(UCase(tagname))
ATTLIST = blo.GetAttributes
For i = LBound(ATTLIST) To UBound(ATTLIST)
If UCase(ATTLIST(i).TAGSTRING) = tagname Or UCase(Trim(ATTLIST(i).TAGSTRING)) = tagname & "_001" Then
'On Error Resume Next
ATTLIST(i).textString = "" & tagvalue
Exit Sub
End If
Next
End If
End Sub
Sub findtitleblock(TITLEBLOCKNAME As String, attributename As String,
attributevalue As String)
Dim entity As AcadEntity
Dim block As acadblcck
Dim blockref As AcadBlockReference
For Each block In ThisDrawing.BLOCKS
For Each entity In block
If InStr(LCase(entity.objectname), "blockref") > 0 Then
Set blockref = entity
If blockref.effectivename = TITLEBLOCKNAME Then
Call block_set_attribute(blockref, attributename, attributevalue)
exit for
End If
End If
End If
Next
Next
End Sub
call findtitleblock("HEADER","TITLE","Bridge column AXIS A_A")
So assume you has a title block which has the attribute TITLE then it will set the Attribute to the drawing name. it mioght also possible you has to replace the thisdrawing. with your Caddoc. I usually control Access and Excel form autocad and not vice versa ;)
consider also to use "REGEN" and "ATTSYNC" if "nothing happens"
thisdrawing.sendcommens("_attsync" 6 vblf )
I am writing a macro that will scrape my company's internal SAP site for vendor information. For several reasons I have to use VBA to do so. However, I cannot figure out why I keep getting these three errors when I attempt to scrape the page. Is it possible that this has something to do with the UAC integrity model? Or is there something wrong with my code? Is it possible for a webpage using http can be handled differently in internet explorer? I am able to go to any webpage, even other internal webpages, and can scrape each of those just fine. But when i attempt to scrape the SAP page, i get these errors. The error descriptions and when they occur are:
800706B5 - The interface is unknown (occurs when I place breakpoints before running the offending code)
80004005 - Unspecified error (occurs when I don't place any errors and just let the macro run)
80010108 - The Object invoked has disconnected from its clients. (I can't seem to get a consistent occurrence of this error, it seems to happen around the time that something in excel is so corrupted that no page will load and i have to reinstall excel)
I have absolutely no idea what is going on. The Integrity page didn't make much sense to me, and all the research I found on this talked about connecting to databases and using ADO and COM references. However I am doing everything through Internet Explorer. Here is my relevant code below:
Private Sub runTest_Click()
ie.visible = True
doScrape
End Sub
'The code to run the module
Private Sub doTest()
Dim result As String
result = PageScraper.scrapeSAPPage("<some num>")
End Sub
PageScraper Module
Public Function scrapeSAPPage(num As Long) As String
'Predefined URL that appends num onto end to navigate to specific record in SAP
Dim url As String: url = "<url here>"
Dim ie as InternetExplorer
set ie = CreateObject("internetexplorer.application")
Dim doc as HTMLDocument
ie.navigate url 'Will always sucessfully open page, regardless of SAP or other
'pauses the exection of the code until the webpage has loaded
Do
'Will always fail on next line when attempting SAP site with error
If Not ie.Busy And ie.ReadyState = 4 Then
Application.Wait (Now + TimeValue("00:00:01"))
If Not ie.Busy And ie.ReadyState = 4 Then
Exit Do
End If
End If
DoEvents
Loop
Set doc = ie.document 'After implementation of Tim Williams changes, breaks here
'Scraping code here, not relevant
End Function
I am using IE9 and Excel 2010 on a Windows 7 machine. Any help or insight you can provide would be greatly appreciated. Thank you.
I do this type of scraping frequently and have found it very difficult to make IE automation work 100% reliably with errors like those you have found. As they are often timing issues it can be very frustrating to debug as they don't appear when you step through, only during live runs To minimize the errors I do the following:
Introduce more delays; ie.busy and ie.ReadyState don't necessarily give valid answers IMMEDIATELY after an ie.navigate, so introduce a short delay after ie.navigate. For things I'm loading 1 to 2 seconds normally but anything over 500ms seems to work.
Make sure IE is in a clean state by going ie.navigate "about:blank" before going to the target url.
After that you should have a valid IE object and you'll have to look at it to see what you've got inside. Generally I avoid trying to access the entire ie.document and instead use IE.document.all.tags("x") where 'x' is a suitable thing I'm looking for such as td or a.
However after all these improvements although they have increased my success rate I still have errors at random.
My real solution has been to abandon IE and instead do my work using xmlhttp.
If you are parsing out your data using text operations on the document then it will be a no-brainer to swap over. The xmlhttp object is MUCH more reliable. and you just get the "responsetext" to access the entire html of the document.
Here is a simplified version of what I'm using in production now for scraping, it's so reliable it runs overnight generating millions of rows without error.
Public Sub Main()
Dim obj As MSXML2.ServerXMLHTTP
Dim strData As String
Dim errCount As Integer
' create an xmlhttp object - you will need to reference to the MS XML HTTP library, any version will do
' but I'm using Microsoft XML, v6.0 (c:\windows\system32\msxml6.dll)
Set obj = New MSXML2.ServerXMLHTTP
' Get the url - I set the last param to Async=true so that it returns right away then lets me wait in
' code rather than trust it, but on an internal network "false" might be better for you.
obj.Open "GET", "http://www.google.com", True
obj.send ' this line actually does the HTTP GET
' Wait for a completion up to 10 seconds
errCount = 0
While obj.readyState < 4 And errCount < 10
DoEvents
obj.waitForResponse 1 ' this is an up-to-one-second delay
errCount = errCount + 1
Wend
If obj.readyState = 4 Then ' I do these on two
If obj.Status = 200 Then ' different lines to avoid certain error cases
strData = obj.responseText
End If
End If
obj.abort ' in real code I use some on error resume next, so at this point it is possible I have a failed
' get and so best to abort it before I try again
Debug.Print strData
End Sub
Hope that helps.
I am looking for a way to permanently delete a MailMessage from Outlook 2000 with VBA code. I'd like to do this without having to do a second loop to empty the Deleted items.
Essentially, I am looking for a code equivalent to the UI method of clicking a message and hitting SHIFT+DELETE.
Is there such a thing?
Try moving it first then deleting it (works on some patchs in 2000) or use RDO or CDO to do the job for you (you will have to install them)
Set objDeletedItem = objDeletedItem.Move(DeletedFolder)
objDeletedItem.Delete
CDO way
Set objCDOSession = CreateObject("MAPI.Session")
objCDOSession.Logon "", "", False, False
Set objMail = objCDOSession.GetMessage(objItem.EntryID, objItem.Parent.StoreID)
objMail.Delete
RDO
set objRDOSession = CreateObject("Redemption.RDOSession")
objRDOSession.MAPIOBJECT = objItem.Session.MAPIOBJECT
set objMail = objRDOSession.GetMessageFromID(objItem.EntryID>)
objMail.Delete
You could also mark the message first before you delete it and the loop through the deleted items folder and find it an dthe call delete a second time. Mark it using a Userproperty.
objMail.UserProperties.Add "Deleted", olText
objMail.Save
objMail.Delete
loop through you deleted items look for that userprop
Set objDeletedFolder = myNameSpace.GetDefaultFolder(olFolderDeletedItems)
For Each objItem In objDeletedFolder.Items
Set objProperty = objItem.UserProperties.Find("Deleted")
If TypeName(objProperty) <> "Nothing" Then
objItem.Delete
End If
Next
Simplest solution of all, similar to the first way:
FindID = deleteme.EntryID
deleteme.Delete
set deleteme = NameSpace.GetItemFromID(FindID)
deleteme.Delete
Do it twice and it'll be gone for good, and no performance killing loop. (NameSpace can be a particular namespace variable, if not in the default store.) Note this only works if you don't delete across stores, which can change the EntryID or remove it entirely.
I know this is an old thread, but since I recently had cause to write a macro that does this, I thought I'd share. I found that the Remove method appears to be a permanent deletion. I'm using this snippet:
While oFilteredItems.Count > 0
Debug.Print " " & oFilteredItems.GetFirst.Subject
oFilteredItems.Remove 1
Wend
I begin with a list of items that have been filtered by some criteria. Then, I just delete one at a time until it's gone.
HTH
You can use the following approach, basically you delete all of your email messages as you are currently doing, then call this one line to empty the deleted items folder. The code is in jscript, but I can translate if you really need me to :)
var app = GetObject("", "Outlook.Application"); //use new ActiveXObject if fails
app.ActiveExplorer().CommandBars("Menu Bar").Controls("Tools").Controls('Empty "Deleted Items" Folder').Execute();
Recently I had to permamentnly delete all contacts. This worked for me (Outlook 2016). You have obtain new reference to the item in the trash folder, otherwise it says "already deleted" or something like that. Just go from the end and the recently moved items will be there. Then calling Delete achieves permanent deletion. This snippet can be used in a loop.
myContacts(i).Move (trashFolder)
trashCount = trashFolder.Items.Count
For j = trashCount To 1 Step -1
Set trashItem = trashFolder.Items(j)
If trashItem.MessageClass = "IPM.Contact" Then
trashItem.Delete
Else
Exit For
End If
Next