Can't get value from DatePicker - vba

I have a DatePicker control on a worksheet. When I'm in the embedded code for the worksheet, I can access the control's value as follows:
Public Sub showValue()
Debug.Print Me.DTPicker21.value
End Sub
I would like to get the value from a module. Code here:
Sub getDate()
Dim obj As Object
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("Tool interface")
For Each obj In sht.OLEObjects
If obj.Name = "DTPicker21" Then
Debug.Print obj.value
End If
Next
End Sub
When I run this, the obj.value triggers this error:
Object doesn't support this property or method
I checked the list of properties for obj using this procedure, and there is no value property. How can I get the date value that's been set in the DatePicker?

I don't know all of the details, but some of the OLEObjects require that you first access their Object property, then you can access other properties. I think the OLEObject serves as a container, then the "sub-object" is the actual object with which you want to interact. For example, if you run the following two lines of code, you will see that the first returns OleObject and the second returns DTPicker:
Debug.Print "Obj: " & TypeName(obj)
Debug.Print "Obj.Object: " & TypeName(obj.Object)
In your case, try the following code change to remove the error(note the Debug line):
Sub getDate()
Dim obj As Object
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("Tool interface")
For Each obj In sht.OLEObjects
If obj.Name = "DTPicker21" Then
Debug.Print obj.Object.Value
End If
Next
End Sub

Related

accessing word variable or content control from outlook vba

I'm trying to access from Outlook VBA, either a variable or content control ID that I've created in a word Macro.
Basically I am trying to get set a text field equal to a string variable and load this variable to a message box in outlook.
From outlook, I have the code that creates a word object, and opens the active document, but I'm confused as to accessing the variables. I've tried making the variable in word VBA a public variable with no luck.
Current code to access the variable from outlook:
Set oWordApp = CreateObject("Word.Application")
Set oWordDoc = oWordApp.Documents.Open("C:\Owner\Desktop\Job.docx")
oWordApp.Visible = True
MsgBox(oWordApp.testtest)
Having a look at the ContentControl help file you can pull back the text from the content control using its Tag property.
Sub Test()
Dim oWordApp As Object
Dim oWordDoc As Object
Dim oContent As Variant
Dim oCC As Variant
Set oWordApp = CreateObject("Word.Application")
Set oWordDoc = oWordApp.Documents.Open("S:\DB_Development_DBC\Test\MyNewDoc.docm")
oWordApp.Visible = True
Set oContent = oWordDoc.SelectContentControlsByTag("MyCalendarTag")
If oContent.Count <> 0 Then
For Each oCC In oContent
MsgBox oCC.PlaceholderText & vbCr & oCC.Range.Text
Next oCC
End If
End Sub
The code above displayed Click here to enter a date. as the PlaceHolderText value and 01/01/2007 as the Range.Text value. So no need to add separate functions; just reference the content control directly.
https://msdn.microsoft.com/en-us/library/office/gg605189(v=office.14).aspx
https://msdn.microsoft.com/en-us/vba/word-vba/articles/working-with-content-controls
Edit
As an example of returning value from multiple controls in one function:
Public Sub Example()
Dim MySevenTags As Variant
Dim x As Long
MySevenTags = Array("Tag1", "Tag2", "Tag3", "Tag4", "Tag5", "Tag6", "Tag7")
For x = LBound(MySevenTags) To UBound(MySevenTags)
MsgBox ReturnFromWordContent(CStr(MySevenTags(x))), vbOKOnly
Next x
End Sub
Public Function ReturnFromWordContent(TagID As String) As Variant
Dim oWordApp As Object
Dim oWordDoc As Object
Dim oContent As Variant
Dim oCC As Variant
Set oWordApp = CreateObject("Word.Application")
Set oWordDoc = oWordApp.Documents.Open("S:\DB_Development_DBC\Test\MyNewDoc.docm")
oWordApp.Visible = True
Set oContent = oWordDoc.SelectContentControlsByTag(TagID)
'I've made this next bit up.
'No idea how to get the type of control, or how to return the values.
Select Case oContent.Type
Case "calendar"
ReturnFromWordContent = oContent.Range.Date
Case "textbox"
ReturnFromWordContent = oContent.Range.Text
Case Else
'Return some default value such as Null which
'won't work in this case as it's returning to a messagebox
'but you get the picture.
End Select
' If oContent.Count <> 0 Then
' For Each oCC In oContent
' MsgBox oCC.PlaceholderText & vbCr & oCC.Range.Text
' Next oCC
' End If
End Function
"I've tried making the variable in word VBA a public variable with no luck."
Declare your macro "testtest" as a function with the return value of your variable.
Public Function testtest() As String
dim myVariabel as String
myVariable = "test"
' return value
testtest = myVariable
End Function
Best regards

VBA - Storing a range into a Range Property on a user class

I have a class that has the following definition:
Private pvtRngTest1 As Range
Public Property Get RngTest1() As Range
Set RngTest1 = pvtRngTest
End Property
Public Property Set RngTest1(ByVal rng As Range)
Set pvtRngTest1 = rng
End Property
When I'm using this class, I'm trying:
Sub FindAllTablesOnSheet(oSh As Worksheet)
Dim oLo As ListObject
For Each oLo In oSh.ListObjects
MsgBox "Table found: " & oLo.Name & ", " & oLo.Range.Address
Dim sr As SheetRanges
Set sr = New SheetRanges
Set sr.RngTest1 = oLo.Range
MsgBox sr.RngTest1.Address
Next
End Sub
I get an error: Object Required (on the last line within the Next statement)
Can someone please help explain? I believe I'm setting the Range property correctly, I get no error when I set it, but then I cannot access the Address of that property.
As https://stackoverflow.com/users/3598756/user3598756 said above, it was typo. Been about 10 years since I looked at VBA and overlooked the benefits of Option Explicit. :S

Why can't I get an item from a Collection and store it in a variable?

I have a Collection which I use to have a String -> MailItem map. I fill the map, and when I find a duplicate key I want to read the item in the Collection.
This seems so easy, but I spent more than an hour trying to figure out why I can't assign a Collection item to a local variable. (see PROBLEM in code below)
oMailOther = cMails.Item(cMailKey) "Object variable or With block variable not set"
Set oMailOther = cMails.Item(cMailKey) "Object required"
The other cMails(cMailKey) form gives the same error. Moving the Dim around doesn't make any difference. cMails must be available because it's used earlier in the method. Note the Debug.Print line just before this statement, that works. What am I missing?
Option Explicit
Option Compare Text
Public cMails As Collection
Public Sub GetOutlookAttachments()
Set cMails = New Collection
Dim oStore As Store
For Each oStore In Session.Stores
If oStore.DisplayName = "Outlook Data File" Then
ProcessFolder oStore.GetRootFolder()
End If
Next
End Sub
Private Sub ProcessFolder(oFolder As Folder)
Debug.Print oFolder.FolderPath
ProcessItems oFolder.Items
Dim oSubFolder As Folder
For Each oSubFolder In oFolder.Folders
ProcessFolder oSubFolder ' recurse
Next
End Sub
Private Sub ProcessItems(oItems As Items)
Dim oItem As Object
For Each oItem In oItems
DoEvents
If TypeOf oItem Is MailItem Then
Dim oMail As MailItem
Set oMail = oItem
Dim cMailKey As String
cMailKey = oMail.ConversationID & "-" & oMail.ConversationIndex
If Not Contains(cMails, cMailKey) Then
cMails.Add oMail.Subject, cMailKey
Else
Debug.Print cMails.Item(cMailKey)
Dim oMailOther As MailItem
PROBLEM oMailOther = cMails.Item(cMailKey)
Debug.Print cMailKey & ": " & oMailOther.Subject
End If
ElseIf TypeOf oItem Is MeetingItem Then
' ignore
Else
Debug.Print "oItem Is a " & TypeName(oItem)
End If
Next oItem
End Sub
Public Function Contains(col As Collection, key As Variant) As Boolean
Dim obj As Variant
On Error GoTo err
Contains = True
obj = col(key)
Exit Function
err:
Contains = False
End Function
I also tried to replicate similar Add and Item calls elsewhere and it works.
Public Sub Test()
Set cMails = New Collection
Dim cMailKey As String
cMailKey = "hello"
cMails.Add Session.Stores.Item(1), cMailKey
Debug.Print cMails(cMailKey)
Dim oStore As Store
Set oStore = cMails(cMailKey)
Debug.Print oStore.DisplayName
End Sub
I copied your code and ran it. The collection cMails you are creating is a collection of Strings, not of mail objects; however, oMailOther is declared as an Object of type MailItem.
In your assignment without the Set keyword, VB complains that your want to assign something to an object (left-hand side) and should use the Set keyword. Now, with the Set keyword, VB complains that the right-hand side is not an object...
To make cMails into a colection of mail items, change the Add statement as follows:
cMails.Add oMail, cMailKey
(i.e. you don't add oMail.Subject but the whole oMail object.)
Now use the Set keyword in Set oMailOther = cMails.Item(cMailKey) and everything works fine.
oMailOther is a MailItem, so without a question you must use Set what assigning it to a variable:
Set oMailOther = cMails(cMailKey)
However your cMails collection does not contain a MailItem object. It contains only subjects (that are strings as opposed to objects) that you previously added with cMails.Add oMail.Subject, cMailKey.
Apparently you meant cMails.Add oMail, cMailKey.
The problem isn't how you are retrieving the items, it's how you're adding them:
If Not Contains(cMails, cMailKey) Then
cMails.Add oMail.Subject, cMailKey
Else
Collection.Add's first parameter is what you are storing in the collection - in this case the Subject. When you are trying to retrieve items from the collection here...
Debug.Print cMails.Item(cMailKey)
Dim oMailOther As MailItem
MailOther = cMails.Item(cMailKey)
Debug.Print cMailKey & ": " & oMailOther.Subject
...you are trying to retrieve the object itself. The Debug.Print works because you have a Collection filled with Strings.
If you need a collection of MailItem, you need to fill it like this:
cMails.Add oMail, cMailKey

Workbook not found when trying to call function from Excel-add in

I'm trying to call a function from a 3rd party Excel-add in a VBA-sub. The function loads data from a database into specified cells in the Excel workbook.The function I'm calling is huge and unfortunaly I can't post it in its entirety, but here are the first two lines:
Public Function loadFromDatabase(ByVal XLname As String, ByVal sMark As String)
Dim xlWB As Workbook
Then it declares a bunch of variables before running the following tests:
'
' Get the excel book and check if it is run in compatibility mode
'
Set xlWB = getXLBook(XLname)
If xlWB Is Nothing Then
loadFromDatabase = "Workbook '" + XLname + "' not found!"
Exit Function
End If
bExcel8Limits = True
If isExcel2007orLater Then
bExcel8Limits = bCheckCompMode(xlWB)
End If
Here I get this message: "Workbook " not found!" http://imgur.com/HQFAzoC .
The getXLBook function looks like this:
'
' Routine to get a specified Workbook
'
Function getXLBook(sName As String) As Workbook
Dim xlWB As Workbook
On Error Resume Next
Set xlWB = Nothing
Set xlWB = Application.Workbooks(sName)
On Error GoTo 0
Set getXLBook = xlWB
End Function
A hint here may be that I'm able to call the function from a Private Sub place in a worksheet like this...
Private Sub loadFromDB()
Dim res As Variant
res = Application.Run("loadFromDatabase", Me.Parent.Name, "")
If res <> "OK" Then
MsgBox res
End If
End Sub
...but not from a module in the same workbook like this
Sub loadFromDB_test()
Dim res As Variant
res = Application.Run("loadFromDatabase", XLname, sMark)
If res <> "OK" Then
MsgBox res
End If
End Sub
Any suggestions?
Edit: To clarify, it's when running loadFromDB_test the "Workbook not found" message pops up.
Edit 2: An obvious hotfix (that I didnt think of) is to just call the Private Sub in the worksheet from the Sub in the module.
Sub load_test_new()
Application.Run "Sheet1.loadFromDB"
End Sub
From a learning point of view this is clearly not a good solution as it is inefficient coding.
Based on the msgbox you display, you're passing an empty string to the function getXLBook. (within the scope of getXLBook this value is stored as sName, but the cause of the error is before you call this function).
So, somewhere in your code, before this:
Set xlWB = getXLBook(XLname)
You should have a line like this, where the right side of the statement assigns a string representing a full, valid filepath:
XLName = "C:\filename.xlsx"
I suspect that your code does not contain this assignment statement, so that should explain the error.

Upgrading VBA 6->7 causes error: If Exists in Collection

VBA6 code (Excel) worked great. Upgrade to Office 2010/VBA7, code breaks.
Using code from SO:
Determining whether an object is a member of a collection in VBA
Public Function Contains(col As Collection, key As Variant) As Boolean
Dim obj As Variant
On Error GoTo err
Contains = True
obj = col(key)
Exit Function
err:
Contains = False
End Function
I get run-time error 5: Invalid procedure call or argument.
It doesn't make sense to me though because the error occurs on the obj = col(key) line which should be covered by the On Error GoTo err statement, but it stops.
Other If X exists in collection type solutions have the same problem.
Instead of fixing the broken code, what I really need is to be able to see if a record is already set for a collection, if that can be done some other (new) way in VBA7, that would solve the problem as well (I can dream).
I find that if I change specify an object, e.g., a worsheet, it works:
Public Function Contains(col As Collection, key As Variant) As Boolean
Dim ws As Excel.Worksheet
On Error GoTo err
Contains = True
Set ws = col(key)
Exit Function
err:
Contains = False
End Function
I call it like this:
Sub test()
Dim ws As Excel.Worksheet
Dim coll As Collection
Set coll = New Collection
For Each ws In ThisWorkbook.Worksheets
coll.Add ws, ws.Name
Next ws
Debug.Print Contains(coll, ActiveSheet.Name)
Debug.Print Contains(coll, "not a worksheet name")
End Sub
I get True for the first call and False for the second.