I am trying to ensure that I am addressing entities in ModelSpace, but I get an exception that gives no hint at what the problem is because it's a COM object I guess. Does anyone know what I might be doing wrong? If I take out that line (and the zoom extents line) the remaining code works just fine, so I know my document object is being set correctly.
Dim acDWG As AutoCAD.AcadDocument
' open the drawing
acDWG = acApp.Documents.Open(dgvr.Cells("FullName").Value.ToString)
' ensure the drawing has the modelspace tab activated (doesnt work)
acDWG.ActiveSpace = AutoCAD.AcActiveSpace.acModelSpace
' zoom to extents (sometimes works, sometimes not) '
acApp.ZoomExtents()
' build a selectionset of all blocks named 'Solid1' and then delete them all
Dim ss As AutoCAD.AcadSelectionSet = acDWG.SelectionSets.Add("DELETE")
Dim gpCode(1) As Int16
Dim dataValue(1) As Object
gpCode(0) = 0 : dataValue(0) = "Insert"
gpCode(1) = 2 : dataValue(1) = "Solid1"
ss.Select(AutoCAD.AcSelect.acSelectionSetAll,,, gpCode, dataValue)
ss.Erase()
ss.Delete()
ss = Nothing
Update: I discovered why I am getting the error. The code is correct, but the problem is that the drawing has not completed opening yet. If I put a "wait for 5 seconds" line of code directly after the Open line, it works just fine. So it seems my question is how to open the drawing and have VB.Net wait for a signal from the COM object that it is "ready to continue"? (not sure how to word it)
Use a combination of Do...Loop and a Try...Catch block to "wait" like this:
Dim acDWG As AutoCAD.AcadDocument
acDWG = acApp.Documents.Open(dgvr.Cells("FullName").Value.ToString)
Dim bOpen As Boolean = False
Do Until bOpen = True
Try
acDWG.ActiveSpace = AutoCAD.AcActiveSpace.acModelSpace
bOpen = True
Catch ex As Exception
' ignore the error and try again until it is open
End Try
Loop
Related
The situation is as follows:
We want to publish to a remote machine a locally edited file. This file could be of type Word, Excel, Powerpoint. Apparently, after the publishing to the remote machine, we would like the local document to be marked as final, in order to prevent the user from editing it again (, because the intented workflow is first downloading it from the remote server, editing the downloaded document and the publishing it back to the server).
So, there is a bunch of code like this:
Public Sub setDocFinal()
Select Case addin.HostType
Case ADXOfficeHostApp.ohaWord
Dim doc As Word.Document = Nothing
Try
doc = addin.WordApp.ActiveDocument
doc.Final = True
Catch ex As Exception
Throw New Exception(Me.addin.getLabel("cannotSaveCopy", "Cannot Save the document."))
Finally
Marshal.ReleaseComObject(doc)
End Try
Case ADXOfficeHostApp.ohaExcel
Dim doc As Excel.Workbook = Nothing
Try
doc = addin.ExcelApp.ActiveWorkbook
doc.Final = True
'doc.RefreshAll()
'doc.CalculateUntilAsyncQueriesDone()
'doc.Calculate()
Catch ex As Exception
Throw New Exception(Me.addin.getLabel("cannotSaveCopy", "Cannot Save the document."))
Finally
Marshal.ReleaseComObject(doc)
End Try
' Powerpoint case intentionally skipped as is has same format/code
End Select
End Sub
The above code works pretty well for the Word case, but when it comes to Excel, it stacks on the popup which informs the user for the publish action to the remote server:
EDIT
At that particular point, the execution freezes (or maybe gets into an infinite internal loop, because the only available buttons in debugging mode are pause and stop) at the line of setting the document as final and it never reaches the finally statement (where we release the object). It also seems like the execution tries to return control back to the excel document, but nothing more than this notification occurs :
Any idea of what is wrong in the above code, regarding the handling of Excel?
The lines in comments display some trials I have been going through, while trying to find a solution around the net.
In addition, here is also the popup's related code:
Private Sub doWork(ByVal action As String, ByVal e As System.ComponentModel.DoWorkEventArgs)
Dim myDoc As MyDocument
myDoc = DirectCast(e.Argument, MyDocument)
System.Diagnostics.Debug.WriteLine("Post in Thread")
Dim resultObject(3) As Object
resultObject(0) = True
resultObject(1) = myDoc
Dim saveDocumentResult As SaveDocumentResult = Nothing
Try
Select Case action
Case Constants.SAVE_DRAFT
saveDocumentResult = myDoc.getRequestService().saveDraft(myDoc.getSaveFile(), myDoc.getDocName(), myDoc)
Case Constants.PUBLISH
saveDocumentResult = myDoc.getRequestService().publishDocument(myDoc.getSaveFile(), myDoc.getDocName(), myDoc)
myDoc.setDocFinal() 'this line makes the call to the above code
End Select
myDoc.updateDocumentProperty(Constants.VERSION, saveDocumentResult.version)
myDoc.updateDocumentProperty(Constants.HASH, saveDocumentResult.hash)
myDoc.setSaved(True)
System.Threading.Thread.Sleep(1500)
Catch ex As Exception
resultObject(0) = False
resultObject(2) = ex.Message
Finally
e.Result = resultObject
End Try
End Sub
I have following code in an lotusscript agent that removes attachments from NotesDocuments. But NotesDocument.save() causes loss of rich text formatting (font, color). Is there any way to retain the formatting?
Sub removeAttachments_v2(doc As NotesDocument)
Dim session As NotesSession
Dim rtitem As Variant
Dim filename As String
Dim ans As Variant
Set session = New NotesSession
Dim richstyle As NotesRichTextStyle
Set richstyle = session.CreateRichTextStyle
richstyle.NotesColor = COLOR_BLUE
If doc.HasEmbedded Then
Set rtitem = doc.getfirstitem("Body")
If (rtitem.type = RICHTEXT) Then
ForAll object In rtitem.EmbeddedObjects
If (object.Type = EMBED_ATTACHMENT) Then
filename = object.source
Call object.remove
Call rtitem.AddNewLine( 2 )
Call rtitem.AppendStyle(richstyle)
Call rtitem.AppendText( "Attachemnt removed: " & filename )
Call doc.Save( True, True , True )
End If
End ForAll
End If
End If
End sub
Edit1: Initialize function
Sub Initialize
Dim db As New NotesDatabase("","")
Dim col As NotesDocumentCollection
Dim doc As NotesDocument
Call db.Open("", "C:\this\is\db\dir\test.nsf")
Set col = db.Alldocuments
Set doc = col.Getfirstdocument()
While Not ( doc Is Nothing )
Call RemoveAttachments_v2(doc)
Call doc.Save(False, False, False)
Set doc = col.GetNextDocument( doc )
Wend
End Sub
Despite of the fact, that you save the document for every attachment I cannot find any reason, why this should happen. I just copied your code in an agent, and it removes the attachments as desired and appends the text in blue...
No formatting is lost...
The error has to be somewhere else in your code, probably in the calling function.
OLD ANSWER (wrong due to own tests, just kept here as history):
The Problem here most probably is: you defined rtitem as Variant. And
getfirstitem gets you a NotesItem instead of a NotesRichtextItem, so
when saving, it is converted to a "plain Text" item.
Most probably you used Variant instead of NotesRichtextItem, because
there are Mime- mails where defining the variable as NotesRichtextItem
will cause an "Type Missmatch" or similar error. As long as you do not
write anything back this is OK.
As Mime Mails need complete different handling to achieve your goal,
you should first fix the code for pure NotesRichtextItems by using the
right type, and then write another code- branch for handling Mime-
items
I'm new to VB but recently created my first working app :) Anyway it just compresses files and little bit more. The latest thing that I added was a marquee style progress bar to animate while the operation was in progress and stop when it ends and the user can do the next zip operation. The progress bar wasn't updating, so I used a background worker to do the actual task while the button click just did the animation. Since then I've notcied serious degredation in the app. It struggles to load. I even got an out of memory error. Not sure if the background worker is related, but I thought I'd mention as it was the last update. Has anyone experienced anything similar? If I can provide and specific info, please ask me for it! Many thanks.
UPDATE: So I understand that I'm not using the BGWorker correctly. I will change that. But I found even with that removed, I still had issues. So I created a new form and started adding in bits of my code one by one. Anyway, I fell at the first hurdle with my form load sub. So I added that in slowly. I found that when ever I have any statements that load a variable from settings for persistent settings that the app falls over. Below is my code. Can anyone see what's up?????
UPDATE: I've found that if I load from settings the memory useage shoots up. I tried this too with saving settins on form closed. Below is the error received. The same out of memory occurs when trying to load settings too. I never experienced this on the first form I created. So perhaps I have missed some settings on the second, because the implementation in the code hasn't changed.
System.Configuration.ConfigurationErrorsException: Failed to save settings: An error occurred executing the configuration section handler for userSettings/Backup_Tool.My.MySettings. ---> System.Configuration.ConfigurationErrorsException: An error occurred executing the configuration section handler for userSettings/Backup_Tool.My.MySettings. ---> System.OutOfMemoryException: Exception of type 'System.OutOfMemoryException' was thrown
This is when I added in the code below:
Private Sub Form1_Closed(sender As Object, e As EventArgs) Handles MyBase.FormClosed
' TAB PAGE 1.
' Save controls to settings.
My.Settings.StartPathTextBox1 = StartPathTextBox1.Text
My.Settings.ZipPathTextBox1 = ZipPathTextBox1.Text
My.Settings.CopyPathTextBox1 = CopyPathTextBox1.Text
My.Settings.ZipSelectCheckBox1 = ZipSelectCheckBox1.Checked
My.Settings.CopySelectCheckBox1 = CopySelectCheckBox1.Checked
For Each s As String In StartNameListBox1.Items()
My.Settings.StartNameListBoxItems1.Add(s)
Next
For Each s As String In StartNameListBox1.SelectedItems()
My.Settings.StartNameListBoxSelectedItems1.Add(s)
Next
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' FORM 1.
' Initialise specialised string collections.
If My.Settings.StartNameListBoxItems1 Is Nothing Then
My.Settings.StartNameListBoxItems1 = _
New System.Collections.Specialized.StringCollection
End If
If My.Settings.StartNameListBoxSelectedItems1 Is Nothing Then
My.Settings.StartNameListBoxSelectedItems1 = _
New System.Collections.Specialized.StringCollection
End If
' TAB PAGE 1.
' Restore controls from saved settings.
StartPathTextBox1.Text() = My.Settings.StartPathTextBox1
ZipPathTextBox1.Text() = My.Settings.ZipPathTextBox1
CopyPathTextBox1.Text() = My.Settings.CopyPathTextBox1
ZipSelectCheckBox1.Checked = My.Settings.ZipSelectCheckBox1
CopySelectCheckBox1.Checked = My.Settings.CopySelectCheckBox1
For Each s As String In My.Settings.StartNameListBoxItems1()
StartNameListBox1.Items.Add(s)
Next
For Each s As String In My.Settings.StartNameListBoxSelectedItems1()
StartNameListBox1.SelectedItems.Add(s)
Next
' Decide controls initial states.
If StartNameListBox1.SelectedItems.Count = 0 Then
ZipSelectCheckBox1.Enabled = False
RunButton1.Enabled = False
End If
If ZipSelectCheckBox1.Checked = False Then
ZipPathTextBox1.Enabled = False
ZipBrowseButton1.Enabled = False
End If
If ZipPathTextBox1.Text = String.Empty Then
CopySelectCheckBox1.Enabled = False
End If
If CopySelectCheckBox1.Checked = False Then
CopyPathTextBox1.Enabled = False
CopyBrowseButton1.Enabled = False
End If
End Sub
It appears to be that you are only ever adding the current selections to the Settings collections. You might well clear the ListBox when they make new selections, but you do not do the same thing with the Settings Collections like My.Settings.StartNameListBoxItems1:
For Each s As String In StartNameListBox1.Items()
My.Settings.StartNameListBoxItems1.Add(s)
Next
The collection will have all the items in it from all the other times it has ever run already and you are now going to add more to it. Eventually you will have many, many, many items in it.
My.Settings.StartNameListBoxItems1.Clear ' REMOVE ALL OLD ITEMS
' Save just the current items to the collection
For Each s As String In StartNameListBox1.Items()
My.Settings.StartNameListBoxItems1.Add(s)
Next
use .Clear on both Collections
I create a browser like so, and manually navigate to the web page I need to be. I intend to automatically pull certain elements once I get to the page I need to be on via a seperate macro
Sub Test()
Set CAS = New SHDocVw.InternetExplorer ' create a browser
CAS.Visible = True ' make it visible
CAS.navigate "http://intraneturl"
Do Until CAS.readyState = 4
DoEvents
Loop
This works fine, then I do
Public Sub Gather
Set HTMLDoc2 = CAS.document.frames("top").document
Call Timer1
With HTMLDoc2
.getElementById("tab4").FirstChild.Click
End With
Call Timer2
Dim fir, las, add1, add2, cit, stat, zi As String
Dim First As Variant
Dim Last As Variant
Dim addr1 As Variant
Dim addr2 As Variant
Dim city As Variant
Dim Thisstate As Variant
Dim Zip As Variant
Call Timer2
Set HTMLDoc = CAS.document.frames("MainFrame").document
Call Timer2
With HTMLDoc
First = .getElementsByName("IndFirst")
Last = .getElementsByName("IndLast")
addr1 = .getElementsByName("txtAdd_Line1")
addr2 = .getElementsByName("txtAdd_Line2")
city = .getElementsByName("txtAdd_City")
Thisstate = .getElementsByName("cmb_Add_State")
Zip = .getElementsByName("txtAdd_Zip")
End With
fir = First.Value
las = Last.Value
add1 = addr1.Value
add2 = addr2.Value
cit = city.Value
stat = Thisstate.Value
zi = Zip.Value
'navigate back to start page
With HTMLDoc2
.getElementById("tab3").FirstChild.Click
End With
End Sub
This works the first time, but after the first time, I get "Object variable or with block variable not set" when trying to run the gather() sub again, on a different web page that contains similar information. Any Ideas as to what im doing wrong?
"The error "object variable or with block variable not set" occurs on: Set HTMLDoc2 = CAS.document.frames("top").document the second time i try running Gather()."
This is probably one of three things:
CAS is no longer an object
To check this, set a breakpoint on the line, press ctr+G in the VBA Editor and type ?CAS Is Nothing in the Immediate Window; the result should be False; if it is True CAS is no longer an object
Like Daniel Dusek suggested, make sure CAS.document.frames("top") is an actual element on the page.
To check this, open the webpage you are trying to script, press F12 in Internet Explorer, click on the arrow in the toolbar and click on the "top" frame element in the webpage, switch back to the Developer Tool and look at the line highlighted. Make sure the frame element is named "top".
The HTML hasn't fully loaded when you try to reference the frame element. Set a longer delay or a loop.
i.e. (untested):
Do Until HtmlDoc2 Is Nothing = false
Set HTMLDoc2 = CAS.document.frames("top").document
Loop
Maybe the more important question is why manually navigate to another page? Can't you automate that part of your process too?
I'm working on an app that writes to excel. The following piece f code is working properly ( it fills the requested cell) but generating a run time exception that I can't get rid of.
For i = 1 To 1000 Step 1
If Not (cPart.Range("A" & i).Value = Nothing) Then
If (cPart.Range("L" & i).Value = Nothing) Then
cPart.Range("L" & i).Interior.ColorIndex = 3
End If
i = i + 1
End If
Next
the exception is: COMException was unhandled :Exception from HRESULT: 0x800A01A8
any help?
That HRESULT means Object Required. So it seems like one or more of the objects you try to operate on don't exist but as the code is written at the moment, it's difficult to be sure which it is. An immediate concern though is that you're comparing values to Nothing, in VB.Net you're supposed to use Is Nothing to check for that. Also, you've already set up the For loop to go from 1 to 1000, with a step of 1 (which you don't need to include since it's the default) but you're then doing i = i + 1 which looks like a mistake?
So fixing that and splitting it up into it's parts it might give you a better idea to what's not working:
For i = 1 To 1000
Dim aRange As Object = cPart.Range("A" & i)
If aRange IsNot Nothing AndAlso aRange.Value IsNot Nothing Then
Dim lRange As Object = cPart.Range("L" & i)
If lRange IsNot Nothing AndAlso lRange.Value Is Nothing Then
Dim interior As Object = lRange.Interior
If interior IsNot Nothing Then
interior.ColorIndex = 3
End If
End If
End If
Next
I've declared the new objects as Object which might need to be changed to the correct data types (depending on your project settings).
Hopefully you should now be able to run through the code without error and you should also be able to step through the code and find that one of the new objects (aRange, lRange and interior) is Nothing at some point when it shouldn't be which will show you why it threw that error before.
Another advantage to splitting up the code like this is that you'll now be able to dispose of the Excel objects properly so that the Excel instance can shut down cleanly. See this Q&A for info: Excel.Range object not disposing so not Closing the Excel process