How do you correctly set document properties using VBA? - vba

The problem
I'm having some trouble setting document properties using VBA in Word 2010.
I have a document containing several Heading 1 sections and I use a macro to extract a selected section (along with it's contents) and paste it to a new document.
This part works fine, but at the end I need to set several document properties, but none of them are being set.
I'm trying to set both built-in and custom properties, but for the purpose of this question I'd like to set title, subject and, category.
I've created a function to set the properties I desire (as below), and VBA is throwing no error (even when I remove error handling in the function).
Does anybody know what I am doing wrong?
How the function should work
Here is a brief summary of what the function should do, but the full function is below should you find it easier to check that -
Check to see if the property already exists
It does and it is a default property
Set the default property
Set the PropertyTypeUsed variable to default
it does and it is a custom property
Set the custom property
Set the PropertyTypeUsed variable to custom
It does not exist at all
Create a new custom property
Set the custom property
Set the PropertyTypeUsed variable to custom
Check whether or not a value has successfully been set
A default property should have been set
Was the property set successfully?
A custom property should have been set
Was the property set successfully?
Return the result
The function I believe is causing the issue
Function UpdateDocumentProperty(ByRef doc As Document, _
ByVal propertyName As String, _
ByVal propertyValue As Variant, _
Optional ByVal propertyType As Office.MsoDocProperties = 4)
'** Set the result to 'False' by default '*
Dim result As Boolean
result = False
'** A property to hold whether or not the property used is default or custom *'
Dim propertyTypeUsed As String
'** Check to see if the document property already exists *'
If PropertyExists(doc, propertyName) Then ' A default property exists, so use that
doc.BuiltInDocumentProperties(propertyName).value = propertyValue
propertyTypeUsed = "default"
ElseIf PropertyExists(doc, propertyName, "custom") Then ' A custom property exists, so use that
doc.CustomDocumentProperties(propertyName).value = propertyValue
propertyTypeUsed = "custom"
Else ' No property exists, so create a custom property
doc.CustomDocumentProperties.Add _
name:=propertyName, _
LinkToContent:=False, _
Type:=propertyType, _
value:=propertyValue
propertyTypeUsed = "custom"
End If
'** Check whether or not the value has actually been set *'
On Error Resume Next
If propertyTypeUsed = "default" Then
result = (doc.BuiltInDocumentProperties(propertyName).value = propertyValue)
ElseIf propertyTypeUsed = "custom" Then
result = (doc.CustomDocumentProperties(propertyName).value = propertyValue)
End If
On Error GoTo 0
UpdateDocumentProperty = result
End Function
Full project code
The full code for this project can be found in two Paste Bins -
The functions
The form
I'm not sure if it's possible to get the code for actually creating the form (short of exporting it, but I have no where to put it), but in any case it's very simple -
The form - frmChooseDocument
The label - lblChooseDocument (Which New Starter document would you like to export?)
The combobox - comChooseDocument
The cancel button - btnCancel
The OK button - btnOK (Initially disabled)
In reality I'm using the document that houses this code as a 'master' document for new startes, containing detailed instructions on how to use variouse applications.
The code itself looks for Heading 1 formatted text within the document and adds them to the combobox in the form, allowing the user to select a section to export. A new document is then created and saved as a PDF.
Update
As suggested in the comments, I have checked that the type of value being set matches that of the value being passed to the function and it does.
In the case of all 3 properties described above, both the value that I am passing and the property as stored against the document are of type string.
I've added a couple of lines to output the type and value where I am setting the result and all looks well, but obviously it is not!
Debug.Print "My value: (" & TypeName(propertyValue) & ")" & propertyValue
Debug.Print "Stored property: (" & TypeName(doc.BuiltInDocumentProperties(propertyName).value) & ")" & doc.BuiltInDocumentProperties(propertyName).value
Here is the output -
My value: (String)New Starter Guide - Novell
Stored property: (String)New Starter Guide - Novell
My value: (String)New starter guide
Stored property: (String)New starter guide
My value: (String)new starters, guide, help
Stored property: (String)new starters, guide, help

I managed to set my word document title by saving the document after changing the property. I set the "Saved" property to false first to make sure that Word registers the change in state.
Function ChangeDocumentProperty(doc As Document, sProperty As String, sNewValue As String)
Debug.Print "Initial Property, Value: " & sProperty & ", " & doc.BuiltInDocumentProperties(sProperty)
doc.BuiltInDocumentProperties(sProperty) = sNewValue
doc.Saved = False
doc.Save
ChangeDocumentProperty = (doc.Saved = True And doc.BuiltInDocumentProperties(sProperty) = sNewValue)
Debug.Print "Final Property, Value: " & sProperty & ", " & doc.BuiltInDocumentProperties(sProperty)
End Function
Immediate Window:
? ThisDocument.ChangeDocumentProperty(ThisDocument, "Title", "Report Definitions")
Initial Property, Value: Title, Report Glossary
Final Property, Value: Title, Report Definitions
True

Permanent object properties cannot be set by functions. In other words, VBA does not allow functions to have side effects that persist after the function is finished running.
Re-write the function as a Sub and it should work.

Related

Access VBA - How to get the properties of a parent subform, or, get the user-given name for a subform (not the object reference name)

In MS Access 2016, let's say I have 2 forms: frmMain and frmBaby.
I have embedded frmBaby as a subform on frmMain. I have embedded on frmBaby a control (let's say it's a textbox, but it could be any control) named tbxInput.
On frmMain, since frmBaby is a "control" on frmMain, I have given that control the traditional name of subfrmBaby.
Now, in VBA, an event on subfrmBaby passes the tbxInput control ByRef (as Me.tbxInput) to a function that is meant to return the .Left property of the parent of the control passed ByRef. That is, I need the function to determine the .Left property for the location of subfrmBaby on frmMain. (The function is more complicated than this, but for the sake of keeping this question let's just say the function is returning the .Left property value because the .Left value is what I need to perform the function.)
Let's say the function is: Public Function fncLocation(ByRef whtControl As Variant) as Long
(I use Variant so that null values can be passed.)
Here is the code that I expected to return the .Left value of the parent (i.e., subfrmBaby) of whtControl: lngLeft = whtControl.Parent.Left
However, that gives me an error of: "Application or object-defined error"
When I use the immediate window to check things out I find that whtControl.Parent.Name is "frmBaby" and not "subfrmBaby" which makes it problematic to reference the subform on frmMain since I cannot figure out how to get the actual name given to the control on frmMain from the object passed to the function and so I cannot reference the subform by name either.
Questions:
How can I get the .Left value for the parent of the control passed to this function?
How can I get the actual name assigned to the subform control on frmMain? In this case, I need the name of "subfrmBaby" rather than "frmBaby."
Thanks in advance for ideas.
You can do this by iterating the controls on the main form, assuming whtControl is the form object of the subform (if it's a textbox, it's whtControl.Parent.Parent and If c.Form Is whtControl.Parent Then)
Dim mainForm As Form
Set mainForm = whtControl.Parent
Dim c As Access.Control
Dim subformControl As Access.Control
For Each c In mainForm.Controls
If TypeOf c Is SubForm Then
If c.Form Is whtControl Then
Set subformControl = c
Exit For
End If
End If
Next
If Not subformControl Is Nothing Then
Debug.Print subformControl.Left
End If
Note that iterating controls comes at a performance penalty, but this code should still take milliseconds, not seconds. Also, since we test reference equality, it works even if the same subform is present multiple times on the parent form.
I just had this issue, and I think I solved it! Thanks to Eric A's answer above to get me started. I tweaked it and built on it for my use. In my case, I needed to save the "full" address of a control to build and facilitate a control log (used to log both user actions for auditing and to allow for users to "undo" an action). I have several duplicated subforms in several sub-form controls, and a few sub-sub forms (each displaying differently filtered and sorted data), so I couldn't rely on simply knowing the subform's name, I also needed the subform control name. This also leverages others' work (as noted in the code notes with some tweaks to allow easier re-use for us. I've posted it here, hopefully it will help someone else. I know I've used SO a lot.
How we use it:
On a form, after logging an action, we record the control's ID info, which calls a function to get the toppost form (this is used in conjunction with afterUpdate event so we refresh the main form and subform). We also use the HWND to validate some other items elsewhere, and to grab a form if we don't have the initial form reference. If you use this and modify it, please point back to here and give comments.
Specific Function Code to get Control "address" and get control from address
' Posted on StackOverflow 2022 February 18 in response to Question:
' https://stackoverflow.com/q/66425195/16107370
' Link to specific answer: https://stackoverflow.com/a/71176443/16107370
' Use is granted for reuse, modification, and sharing with others
' so long as reference to the original source is maintained and you
' help lift others up as others have done those who helped with this concept
' and code.
Private Function GetControlAddress(ByRef ControlTarget As Object, _
ByRef ParentForm As Access.Form) As String
' Used in concert with building a form ID, this allows reflection back to the specific
' subform control and containing subform.
Dim ControlSeek As Access.Control
If TypeOf ControlTarget Is Form Then
' You need to dig through the whole list to get the specific controls for proper reflection down.
For Each ControlSeek In ParentForm.Controls
If ControlSeek Is ControlTarget Then
GetControlAddress = ParentForm.Name & FormIDHWNDSep & ParentForm.Hwnd & FormIDHWNDSep & ControlTarget.Name & FormIDFormSep
Exit For
ElseIf TypeOf ControlSeek Is SubForm Then
If ControlSeek.Form Is ControlTarget Then
GetControlAddress = ParentForm.Name & FormIDHWNDSep & ParentForm.Hwnd & FormIDHWNDSep & ControlSeek.Name & FormIDFormSep
End If
End If
Next ControlSeek
Else
' If you're not looking for a form, then you can skip the slow step of running through all controls.
GetControlAddress = ParentForm.Name & FormIDHWNDSep & ParentForm.Hwnd & FormIDHWNDSep & ControlTarget.Name & FormIDFormSep
End If
End Function
Public Function GetControlByAddress(ByRef StartingForm As Access.Form, ByRef strControlAddress As String) As Access.Control
' Given a control address and a starting form, this will return that control's form.
Dim ControlTarget As Access.Control
Dim TargetForm As Access.Form ' This is a reference to the hosting control
'Dim ControlSeek As
Dim FormIDArr() As String
Dim FormInfo() As String
Dim ControlDepth As Long
Dim CurrentDepth As Long
If strControlAddress = vbNullString Then GoTo Exit_Here
FormIDArr = Split(strControlAddress, FormIDFormSep)
' Because there's always a trailing closing mark (easier to handle buidling address), we skip the last array
' value, as it's always (or supposed to be...) empty.
ControlDepth = UBound(FormIDArr) - LBound(FormIDArr)
' Split out the form's Specific Information to use the details.
FormInfo = Split(FormIDArr(CurrentDepth), FormIDHWNDSep)
' The specific control is located in the 3rd element, zero referenced, so 2.
Set ControlTarget = StartingForm.Controls(FormInfo(2))
' If ControlDepth is 1 (control is on passed form) you can skip the hard and slow work of digging.
If ControlDepth > 1 Then
For CurrentDepth = 1 To ControlDepth - 1
' Note: you start at 1 because you already did the first one above.
' Split out the form's Specific Information to use the details.
FormInfo = Split(FormIDArr(CurrentDepth), FormIDHWNDSep)
Set TargetForm = ControlTarget.Form
Set ControlTarget = TargetForm.Controls(FormInfo(2))
Next CurrentDepth
End If
Exit_Here:
Set GetControlByAddress = ControlTarget
End Function
Required Helper Functions
Note, I use a property for the separators as there is some user locale handling (no included), and it also ensures that if we do change the separator it remains consistent. In this example, I simply set them to a character which is unlikely to be used in a form name. You will need to ensure your forms don't use the separator characters.
Public Function hasParent(ByRef p_form As Form) As Boolean
' Borrowed concept from https://nolongerset.com/get-top-form-by-control/
' and modified for our uses.
On Error Resume Next
hasParent = (Not p_form.Parent Is Nothing)
Err.Clear ' The last line of this will cause an error. Clear it so it goes away.
End Function
Private Function GetFormObjectByCtl(ByRef ctl As Object, _
ByRef ReturnTopForm As Boolean, Optional ByRef strControlAddress As String) As Form
strControlAddress = GetControlAddress(ctl, ctl.Parent) & strControlAddress
If TypeOf ctl.Parent Is Form Then
If ReturnTopForm Then
If hasParent(ctl.Parent) Then
'Recursively call the function if this is a subform
' and we need the top form
Set GetFormObjectByCtl = GetFormObjectByCtl( _
ctl.Parent, ReturnTopForm, strControlAddress)
Exit Function
End If
End If
Set GetFormObjectByCtl = ctl.Parent
Else
'Recursively call the function until we reach the form
Set GetFormObjectByCtl = GetFormObjectByCtl( _
ctl.Parent, ReturnTopForm, strControlAddress)
End If
End Function
Public Function GetFormByCtl(ctl As Object, Optional ByRef strControlAddress As String) As Form
Set GetFormByCtl = GetFormObjectByCtl(ctl, False, strControlAddress)
End Function
Public Function GetTopFormByCtl(ctl As Object, Optional ByRef strControlAddress As String) As Form
Set GetTopFormByCtl = GetFormObjectByCtl(ctl, True, strControlAddress)
End Function
Public Property Get FormIDHWNDSep() As String
FormIDHWNDSep = "|"
End Property
Public Property Get FormIDFormSep() As String
FormIDFormSep = ";"
End Property
Interesting. I don't think you can.
As you have seen, the parent of whtControl is its form, frmBaby.
The parent of that one is frmMain. The subform control is not part of the object chain when "going up", only when going down.
If you always use the naming scheme as in the question, you could do something like this (air code):
strSubform = whtControl.Parent.Name
strSubformCtrl = "sub" & strSubform
Set ctlSubform = whtControl.Parent.Parent(strSubformCtrl)

How to refer to Word Field by name in VBA Code?

I want to update a word field content using VBA. I already have a code that works, but I have to refer to the field's index instead of field's name, which I would prefer.
The code I have is as follows:
Sub UpdateField()
Dim myString As String
myString = "asdf"
ActiveDocument.Fields(1).Result.Text = myString
End Sub
Suppose that the field's name is MyField1. The following code will not work (I get the Run-time error '13': Type mismatch'.
Sub UpdateField()
Dim myString As String
myString = "asdf"
ActiveDocument.Fields("MyField1").Result.Text = myString
End Sub
I create my word fields from File Menu > Informations > Advanced Properties > Custom Tab.
So, how to refer to the field's name when we want to update its content?
These are DocProperty fields. If you press Alt+F9 you'll see the field codes.
A DocProperty field references (links to) a Document Property. The Document Property has the name, but this does not "name" the field. Nor is it possible to update a DocProperty field directly since it links to the Document Property. It might be possible to make it temporarily display something else, but this will be lost any time the field is updated.
In order to update a DocProperty field it's necessary to update the underlying Document Property. For example
Sub EditDocPropUpdateDocPropertyField()
Dim doc As Word.Document
Dim prop As Office.DocumentProperty
Dim propName As String
Dim newPropValue As String
Set doc = ActiveDocument
propName = "MyField"
newPropValue = "new value"
Set prop = doc.CustomDocumentProperties(propName)
prop.value = newPropValue
doc.Fields.Update
End Sub
In the VBE, the Object Browser is a great way to find out what's possible. When I find Word>Field and click on it, I see a list of the members of Field. Name is not in that list. This means that the field object does not have a Name property. That's why you get the error.
You can work around this. One way is to create a bookmark around the field in question. Then in code, find the bookmark by name, then find the field by index inside the bookmark range.
Sample to set text to fields by field name:
ThisDocument.FormFields.Item("MyField1").Result = "hello"

Add Collection as an item within another collection - Class - Excel VBA

I'm currently trying to build a collection of items wherein a collection might contain an another collection as an Item within.
I've set two collections and created a class module for each:
col1 - (linked to Class1); and col2 - (linked to Class2)
Below are my Class Modules:
Class1:
Option Explicit
Private pTestC1A As String
Private pTestC1B As Collection
Public Property Let TestC1A(Value As String)
pTestC1A = Value
End Property
Public Property Get TestC1A() As String
TestC1A = pTestC1A
End Property
Property Set TestC1B(col2 As Collection)
Set pTestC1B = col2
End Property
Property Get TestC1BElements(v As Integer) As String
TestC1B = pTestC1B(v)
End Property
Class2:
Option Explicit
Private pTestC2A As String
Public Property Let TestC2A(Value As String)
pTestC2A = Value
End Property
Public Property Get TestC2A() As String
TestC2A = pTestC2A
End Property
Below is my Module code
Sub Test()
Set col1 = New Collection
Set col2 = New Collection
Set cV = New Class1
cV.TestC1A = "First Collection"
Set aV = New Class2
aV.TestC2A = "Second Collection"
sKey1 = CStr(aV.TestC2A)
col2.Add aV, sKey1
Set cV.TestC1B = col2
sKey2 = CStr(cV.TestC1A)
col1.Add cV, sKey2
If Err.Number = 457 Then
MsgBox "Error Occured"
ElseIf Err.Number <> 0 Then Stop
End If
Err.Clear
Msgbox col1(1).TestC1A ' works fine
Msgbox col2(1).TestC2A ' works file
MsgBox col1(1).TestC1B(1).TestC2A ' does not work - 450 run-time error
End Sub
As per the above code, I'm successfully able to get the values of the items if I reference each collection respectively, however I'm getting a "Wrong number of arguments or invalid property assignment" run-time error if I try to get the item value in a nested fashion.
It would be appreciated if someone can help point out where I'm going wrong, and perhaps shed some light on the way the class module handles the Property Set & Get parameters for a collection.
You are missing a Get TestC1B property in your Class1 class module:
Property Get TestC1B() As Collection
Set TestC1B = pTestC1B
End Property
Once that is present you will be able to make calls to col1(1).TestC1B(1) and access it's .TestC2A property
Background
You did the right thing by using private variables in your classes and using properties to give read/write access to your private variables. You'll get a lot more control this way.
Property Get gives read access to that property (and broadly speaking, the underlying private variable). For example you can use Range.Address to return (read) the address of a range object.
Property Let and Set give write access to the property. Use Set for objects. For example Range.Value = 1 will write the new value to the range.
Consider, Range.Address = $A$1. Since there is no Property Set for the address of a range, this will not change the address of the range. It will consider the Range.Address part a Get call and evaluate something like $A$1 = $A$1 returning TRUE in this example

refer to name with variable in visual studio 2010 vb

I'm trying to assign text from "comp" in the form "home" to a textbox with the name "d1" in the form "home".
but this needs to be done with a counter in the form "home".
The code is in a module.
What I've tried=
home.controls("d" & home.counter).text = home.comp.text
I keep getting an error:
use the new keyword to create an object instance ==> the textbox exists in the form
check to determine if the object is null before calling the method ==> the textbox is empty
get general help for this exception
You could use Controls.Find:
Dim controls = home.Controls.Find("d" & home.counter, True)
If controls.Length > 0 Then
Dim txt = TryCast(controls(0), TextBoxBase)
If txt IsNot Nothing Then
txt.Text = home.comp.text
End If
End If
However, normally i would not use this approach since it's error-prone. Why don't you provide a public property in the Home-form that you can access? This property would get/set the TextBox' Text.
For example:
Public Property HomeCompText As String
Get
Return txtHomeComp.Text
End Get
Set(value As String)
txtHomeComp.Text = value
End Set
End Property
Now you can use this clear, safe and maintainable code:
home.HomeCompText = home.comp.text
You could even change the underlying control.

Using Lotus from VBA, how to import rich text items to a new session?

I have a VBA function that initializes a lotus notes session, creates a document and mails it. It also accepts as an optional parameter a NotesRichTextItem which I append to the body of the email.
However, I am getting the error message "All objects must be from the same session". How do I 'import' this NotesRichTextItem into my session?
Edit-Code added
Sub SendLotusMail(SubjTxt As String, _
BodyTxt As String, _
EmailTo As String, _
EmailCC As String, _
AutoSend As Boolean, _
Attach As String, _
ReportTitle As String, _
Optional AppendToBody As NotesRichTextItem = Null)
On Error GoTo EH
NtSession.Initialize
OpenMailDb ReportTitle
Set NtDoc = Ntdb.CreateDocument
NtDoc.AppendItemValue "Form", "Memo"
NtDoc.AppendItemValue "SendTo", EmailTo
NtDoc.AppendItemValue "CopyTo", EmailCC
NtDoc.AppendItemValue "Subject", SubjTxt
Set NtBodyRT = NtDoc.CreateRichTextItem("Body")
NtDoc.AppendItemValue "Body", NtBodyRT
If Attach <> "" Then NtBodyRT.EmbedObject EMBED_ATTACHMENT, "", Attach, "Attachment"
NtBodyRT.AppendText BodyTxt
'This next line throws the error "All objects must be from the same session"
NtBodyRT.AppendRTItem AppendToBody
Edit-Solution found
I don't like it very much, but I got around all these issues by passing the RichTextItem object, it's parent NotesDocument, and it's parent's parent NotesSession to this function. So, now I'm calling this procedure with 3 optional objects instead of 1. Hooray.
Edit-New Solution found
Well, the previous solution was causing me problems, so until I find (or someone suggests) a workaround, I'll just use some custom email procedures for the reports that require it. It does duplicate some code, but not significantly.
The issue may be the fact that the NtSession object is being re-initialized in your sub. If the calling routine sends in a rich text item, I am assuming it must have created and initialized a NotesSession as well. If that's the case, you would want your code to re-use that same session. It looks like NtSession is a global - if that's the case, you could:
Enforce that the calling routing always have initialized that global session;
Optionally pass in a NtSession object as an argument (and your code can check if that object is null before creating and initializing its own session); or
Before calling Initialize, check if NtSession already is initialized - to do that, you may be able to check an attribute and see if the object throws on error (non-tested code):
function isNotesSessionInitialized (ns)
on error goto err
dim sUser
sUser = ""
sUser = ns.commonUserName
err:
if (sUser = "") then
return false
else
return true
end if
end function
It would help to see some code here. I'll make a guess at what is happening, though.
In your VBA function, you'll need to create a new NotesRichTextItem object within your email. For instance:
Dim docMail as New NotesDocument(db)
Dim rtBody as New NotesRichTextItem(docMail, "Body")
Call rtBody.AppendRTItem(myRTparameter)
I imagine that should work without an error.
(I'm writing this to close out my question)
I've gotten around this issue by just having separate email procs for the reports that require custom setups. Yes, there is some duplication of code, but it's far better than the behemoth I was about to make.