I am running a search from Excel to get objects Internal ID's by External ID. In ThisWorkbook.Sheets("Other Data").Range("J30").Value I have External ID f5f9a21b-9208-de11-995f-005056bb3dfa. After search code should display Internal ID.
This one works and I am getting a message:
There were 3 objects with the display Id of f5f9a21b-9208-de11-995f-005056bb3dfa
How I can make this code to actually display these ID's for example starting from cell A1?
So instead of just a message:
MsgBox ("There were " & results.Count & " objects with the display Id of" & ThisWorkbook.Sheets("Other Data").Range("J30").Value)
I would get the ID's in Excel? Basically I need results.Count not to count items but input them to Excel.
Code edited according to suggestion, but debugger is pointing to ThisWorkbook.Sheets("Start").Cells(i, 1).Value = results(i)
Private Sub SurroundingSub()
Set oVault = oMFClientApp.BindToVault(szVaultName, 0, True, True)
' Create the condition.
Dim condition As New SearchCondition
Dim oScs: Set oScs = CreateObject("MFilesAPI.SearchConditions")
Dim oVaultConnections As MFilesAPI.VaultConnections
Dim i As Integer
' Set the expression.
condition.Expression.DataStatusValueType = MFStatusType.MFStatusTypeExtID
' Set the condition type.
condition.ConditionType = MFConditionType.MFConditionTypeEqual
' Set the value.
' In this case "MyExternalObjectId" is the ID of the object in the remote system.
condition.TypedValue.SetValue MFDataType.MFDatatypeText, ThisWorkbook.Sheets("Other Data").Range("J30").Value
'Add the condition to the collection.
oScs.Add -1, condition
'Search.
Dim results 'As ObjectSearchResults
Set results = oVault.ObjectSearchOperations.SearchForObjectsByConditions(oScs, MFSearchFlags.MFSearchFlagNone, False) ' False = SortResults
'Output the number of items matching (should be one in each object type, at a maximum).
'MsgBox ("There were " & results.Count & " objects with the display Id of" & ThisWorkbook.Sheets("Other Data").Range("J30").Value)
For i = 1 To results.Count
ThisWorkbook.Sheets("Start").Cells(i, 1).Value = results[i]
Next i
End Sub
EDIT 2
Also () does not work:
If you're looking for a quick and direct way try this:
For i = 1 To results.Count
Cells(i, 1).Value = results(i - 1)
Next i
Tip: Cells(row, column)
Related
I'm trying to link shape data field from external data like excel.
As #JohnGoldsmith suggested I used DropLinked but "I'm getting object name not found" error.
My main agenda is drop multiple shapes on drawing with shape data field "Name", then fill all the shape data field using external data in order. I also used spatial search for dropping shapes on drawing(Thanks to #Surrogate). By the way I'm using Visio Professional 2019.
It's often a good plan to separate chained members so you can identify whether (as #Paul points out) you're having a problem getting to the stencil or the master.
Following is a modified example of link shapes to data. I've ditched all of the spatial search stuff as I think that's a separate issue. If you still have trouble with that I would ask another question and narrow your sample code to not include the data linking part - ie just drop shapes and try and change their position. Bear in mind there's also Page.Layout and Selection.Layout
I think you've got the adding the DataRecordsets in the other linked question, so this example makes the following assumptions:
You have a drawing document open
You have the "Basic Shapes" stencil open (note my version is metric "_M")
You have a DataRecordset applied to the document named "AllNames"
The above record set has a column named "Name" that contains the data you want to link
Public Sub ModifiedDropLinked_Example()
Const RECORDSET_NAME = "AllNames"
Const COL_NAME = "Name"
Const STENCIL_NAME = "BASIC_M.vssx"
Const MASTER_NAME = "Rectangle"
Dim vDoc As Visio.Document
Set vDoc = Application.ActiveDocument
Dim vPag As Visio.Page
Set vPag = Application.ActivePage
Dim vShp As Visio.Shape
Dim vMst As Visio.Master
Dim x As Double
Dim y As Double
Dim xOffset As Double
Dim dataRowIDs() As Long
Dim row As Long
Dim col As Long
Dim rowData As Variant
Dim recordset As Visio.DataRecordset
Dim recordsetCount As Integer
For Each recordset In vDoc.DataRecordsets
If recordset.Name = RECORDSET_NAME Then
dataRowIDs = recordset.GetDataRowIDs("")
xOffset = 2
x = 0
y = 2
Dim vStencil As Visio.Document
Set vStencil = TryFindDocument(STENCIL_NAME)
If Not vStencil Is Nothing Then
Set vMst = TryFindMaster(vStencil, MASTER_NAME)
If Not vMst Is Nothing Then
For row = LBound(dataRowIDs) + 1 To UBound(dataRowIDs) + 1
rowData = recordset.GetRowData(row)
For col = LBound(rowData) To UBound(rowData)
Set vShp = vPag.DropLinked(vMst, x + (xOffset * row), y, recordset.ID, row, False)
Debug.Print "Linked shape ID " & vShp.ID & " to row " & row & " (" & rowData(col) & ")"
Next col
Next row
Else
Debug.Print "Unable to find master '" & MASTER_NAME & "'"
End If
Else
Debug.Print "Unable to find stencil '" & STENCIL_NAME & "'"
End If
Else
Debug.Print "Unable to find DataRecordset '" & RECORDSET_NAME & "'"
End If
Next
End Sub
Private Function TryFindDocument(docName As String) As Visio.Document
Dim vDoc As Visio.Document
For Each vDoc In Application.Documents
If StrComp(vDoc.Name, docName, vbTextCompare) = 0 Then
Set TryFindDocument = vDoc
Exit Function
End If
Next
Set TryFindDocument = Nothing
End Function
Private Function TryFindMaster(ByRef vDoc As Visio.Document, mstNameU As String) As Visio.Master
Dim vMst As Visio.Master
For Each vMst In vDoc.Masters
If StrComp(vMst.NameU, mstNameU, vbTextCompare) = 0 Then
Set TryFindMaster = vMst
Exit Function
End If
Next
Set TryFindMaster = Nothing
End Function
The above code drops six shapes onto the page and adds a Shape Data row (Prop._VisDM_Name) with the corresponding data value. If you want the name text to appear in the shape then you would normally modify the master with an inserted field in the shape's text. (If you get stuck with this part then ask another question.)
One last point is that this example loops through the DataRecordset rows dropping a shape for each one, but there is also a Page.DropManyLinkedU method that allows you to this en masse.
I've added items to my collection, named "Questions". I know it adds items to the collection because Questions.count is the right result in various scenarios. However, I'm unable to extract the value of individual .items within the collection.
It gives me the following error: "Invalid procedure call or argument"
So obviously, there must be something basic I don't understand about collections (I only recently learned about them, please be patient with me).
I'm using the methods that I've found online, specifically:
The site https://excelmacromastery.com/excel-vba-collections/ says I should be able to do this:
"You can also use the Item Property to access an item in the collection. It is the default method of the collection so the following lines of code are equivalent:
Debug.Print coll(1)
Debug.Print coll.Item(1)"
Doesn't work for me, no idea why.
'[1] SELECT BOX
Dim SelectedBox As Long
SelectedBox = Box 'NEED TO CONVERT RESULT OF FUNCTION "BOX" TO A VARIABLE WITH TYPE LONG
'[2] TEST CRITERIA FOR QUESTION
Dim Questions As New Collection
Dim SubjectRange As Long
SubjectRange = ThisWorkbook.Sheets(cmbTopics.Text).Cells(Rows.Count, "A").End(xlUp).Row
Dim BoxMatch As Boolean
Dim ChapterMatch As Boolean
'TEST EACH QUESTION IN TOPIC (DETERMINED BY LISTBOX SELECTIONS)
For X = 2 To SubjectRange
BoxMatch = False 'SAYS WHETHER IT PASSED THE TEST
ChapterMatch = False 'SAYS WHETHER IT PASSED THE TEST
'IS QUESTION IN THE RIGHT BOX?
If ThisWorkbook.Sheets(cmbTopics.Text).Range("D" & X).Value = SelectedBox Then
BoxMatch = True
End If
'IS QUESTION IN THE RIGHT CHAPTER?
For Y = 0 To lbChapters.ListCount - 1
If _
lbChapters.List(Y) = ThisWorkbook.Sheets(cmbTopics.Text).Range("B" & X).Value And _
lbChapters.Selected(Y) = True _
Then
ChapterMatch = True
Next Y
'IF SO, THEN ADD IT TO THE LIST OF CANDIDATE QUESTIONS ("QUESTIONS")
If BoxMatch = True And ChapterMatch = True Then
Questions.Add ThisWorkbook.Sheets(cmbTopics.Text).Range("A" & X).Value
End If
Next X
'MsgBox ("Matches: " & Questions.Count)
Dim n As Long
n = RndBetween(1, Questions.Count)
MsgBox (Questions.Item(n))
I want to be able to extract the string that should be at the location specified by the code.
I saw you said that Questions.count should be greater than 0 but it would result in the error you are seeing. To be sure you should add:
If Questions.count > 0 then
MsgBox (Questions.Item(n))
Else
MsgBox ("Questions was empty")
end if
Also check that "n" is being returned as an integer.
Yeow... That was a mouthful.
I'm setting up a log to track inventory in the office. For some items we have multiple copies of the same tool. I've gotten the VBA to track the owners with userforms and vba, but the multiple-identical-names, first-occurance, blank cell trick is proving to be too much for me.
So what you have is this:
Item Serial Number Owner
Item A 999999999
Item A 999999991
Item A 999999992
Item B 22221
Item B 22222
Item B 22223
Item C hhhg77
Item C hhhg78
Item C hhhg79
I need the code to search for the ITEM name, gathered from ComboBox1 on the Userform, and find the first occurance of the ITEM WITHOUT an owner, (so the corresponding "OWNER" cell should be blank, and put the OWNER, gathered from ComboBox2 on the userform, in that spot.
I've been fooling around with Index & Match and VLookup and countless searches for "Finding First Row" but I've come up empty.
The ranges might be changed, so I'm hesitant to be so specific as to say search between A2:A4, so a search would be best, I think.
What I have so far is this....and it's weak, I apologize.
Public Sub FindBlankOwner()
Dim MultiItem As Range
Dim MultiOwner As Range
Dim ITEM As String
Dim OWNER As String
Dim MultiSerial As Range
Dim NO As Range
ITEM = ComboBox1.Value
STATUS = Application.WorksheetFunction.VLookup(ITEM, LUP, 6, False)
OWNER = ComboBox2.Value
Set ws = Worksheets("Owners")
Set MultiItem = Worksheets("Owners").Range("A1:A28")
Set MultiOwner = Worksheets("Owners").Range("C1:C28")
Set MultiSerial = Worksheets("Owners").Range("B1:B28")
Fillin = Evaluate("INDEX(MultiOwner, MATCH(ITEM, &
' Set FILLIN = Application.WorksheetFunction.Match(ITEM, (MultiItem), 0) And (Application.WorksheetFunction.Match(" ", (MultiOwner), 0))
' NO.Value = OWNER
'Set FILLIN = MultiItem.Find(What:=ITEM) And MultiOwner.Find(What:="")
End Sub
Search for Available Items Based on Empty Owner
I've written some raw code for your review. You were on the right track, but with the methods below we avoid using worksheet functions and instead use VBA methods.
First thing we want to do is find the first occurrence of the user-defined ITEM
After that we check if it has an OWNER or not. If it does, find the next ITEM. If it doesn't, assign the user-defined OWNER to the user-defined ITEM.
I've included some message boxes for clarity and convenience of the end-user.
The Code
Sub FindBlankOwner()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Owners")
Dim ITEM As String: ITEM = ComboBox1.Value
Dim OWNER As String: OWNER = ComboBox2.Value
Dim BlankOwnerFound As Boolean: BlankOwnerFound = False
Dim firstResult As String
Dim ItemRange As Range: Set ItemRange = ws.Range("A:A").Find(What:=ITEM, LookIn:=xlValues, LookAt:=xlWhole)
If Not ItemRange Is Nothing Then
firstResult = ItemRange.Address
Do
If Trim(ItemRange.Offset(0, 2).Value) = "" Then
ItemRange.Offset(0, 2).Value = OWNER
BlankOwnerFound = True
Else
Set ItemRange = ws.Range("A:A").FindNext(ItemRange)
End If
Loop While Not ItemRange Is Nothing And ItemRange.Address <> firstResult And BlankOwnerFound = False
Else: MsgBox "No results for " & ITEM & " found.", vbCritical, "Cannot Find " & ITEM
End If
If BlankOwnerFound = True Then
MsgBox OWNER & " has checked out " & ITEM & " with Serial Number " & ItemRange.Offset(0, 1).Value & ".", _
vbOKOnly, ITEM & " Check-Out Successful"
Else: MsgBox "No available " & ITEM & " in inventory.", vbCritical, "All " & ITEM & " are checked out."
End If
End Sub
NOTE: I haven't tested this code aside from reading it to myself to ensure it makes sense. There may be a couple errors (hopefully not) and if you can't solve them, please don't hesitate to let me know so we can work on it together. Let me know if this works for you :)
I wrote this bit of VBA code that creates a SQL query dynamically based on the number of fields the user has selected and values read from an XL spreadsheet. It basically just adds "FIELD_VARIABLE=VALUE_VARIABLE OR" to the where clause and then removes the final OR after the loop ends.
It works for N number of fields added like I was hoping but my concern is security because I think I could just put like ';DROP TABLE Projects or some other malicious code into the spreadsheet from where the program is reading FIELD_VARIABLES. To a lesser extent since the query is different every time the execution path must be different and that probably slows down execution time.
I'm thinking of looking into parameterized queries or T-SQL to improve this. Was hoping one of you smart folks could point me in the right direction before I waste too much time on this. Here is the relevant VBA code:
'---loop through array of search fields and search values using the same index
'---since the arrays sizes will always be the same and create where filters dynamically
i = 1
For i = LBound(sLookupFields) To UBound(sLookupFields)
Set rngLookup = wsLookupSrc.cells(counter, lLookupCols(i))
'---clear where from last iteration through loop
SQLWhereDynamic = ""
SQLWhereDynamic = SQLWhereDynamic & " p." & sLookupFields(i) & " = '" + CStr(rngLookup.Value) & "' OR"
Next i
'---remove extra ' OR'
SQLWhereDynamic = Left(SQLWhereDynamic, (Len(SQLWhereDynamic) - 3))
SQLValue = wsLookupSrc.cells(counter, lLookupCols(1)).Value
SQLWhereDefault = "WHERE p.ClientId = " + CStr(iClientId) + ""
SQLQuery = SQLSelect + SQLWhereDefault + " AND (" + SQLWhereDynamic + ");"
Making the field name in the WHERE clause a parameter (and therefore dynamic and safe from injection) like you can with the value in the WHERE clause is impossible, I believe. However...
Here's how I would do it. Suppose you have an Excel range with all of the possible fields, search values filled in for those fields you want to search, and a data type (to be used in the code later). This below example shows two fields being searched
Field Value DataType
Sequence 131
CustomerID 200
InvoiceNumber 200
OrderNumber 200
InvoiceDate 8/14/2015 7
Item DS2 200
Location 200
ExportFile 200
DateImported 7
OnHold 11
The user fills in column 2. And the code builds the sql string
Sub MakeSQL()
Dim aSql(1 To 4) As String
Dim aWhere() As String
Dim vaFields As Variant
Dim lWhereCnt As Long
Dim lCnt As Long, i As Long
Dim cn As ADODB.Connection
Dim cmd As ADODB.Command
Dim pm As ADODB.Parameter
'Skip number three until later
aSql(1) = "SELECT *"
aSql(2) = "FROM dbo.InvoiceLine"
aSql(4) = "ORDER BY InvoiceNumber DESC;"
'Grab all the search criteria
vaFields = Sheet1.Range("A2:C11").Value
'Set up the connection
Set cn = New ADODB.Connection
cn.Open sConn
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = cn
'Count how many criteria where filled in
'You could Redim Preserve your aWhere() also
On Error Resume Next
lWhereCnt = Sheet1.Range("B2:B11").SpecialCells(xlCellTypeConstants).Count
On Error GoTo 0
'If there's at least one
If lWhereCnt >= 1 Then
ReDim aWhere(1 To lWhereCnt)
'Fill in an array and create parameters
For i = LBound(vaFields, 1) To UBound(vaFields, 1)
If Len(vaFields(i, 2)) > 0 Then
lCnt = lCnt + 1
'Put in the place holder
aWhere(lCnt) = vaFields(i, 1) & "=?"
'column 3 holds the data type
Set pm = cmd.CreateParameter(vaFields(i, 1) & "_p", vaFields(i, 3), adParamInput)
pm.Value = vaFields(i, 2)
'Variable length data types (I only use varchar, you may use more)
'must have a size specified
If vaFields(i, 3) = adVarChar Then pm.Size = Len(vaFields(i, 2))
cmd.Parameters.Append pm
End If
Next i
'Fill in the "where" section of your sql statement
aSql(3) = "WHERE " & Join(aWhere, " OR ")
End If
cmd.CommandText = Join(aSql, Space(1))
'Change this line to actually execute something
Debug.Print cmd.CommandText
For i = 0 To cmd.Parameters.Count - 1
Debug.Print , cmd.Parameters(i).Name, cmd.Parameters(i).Value
Next i
cn.Close
Set cn = Nothing
End Sub
For this example, the string comes out as
SELECT * FROM dbo.InvoiceLine WHERE InvoiceDate=? OR Item=? ORDER BY InvoiceNumber DESC;
InvoiceDate_p 8/14/2015
Item_p DS2
I have an Add button in the dialog form to add items, its quantity, price , currency and list in the field below. There is a currency field in the form. it is a drop down list with many currencies. The currency should be same on adding the items. if there is currency change, message box should appear. below is the part of the code for add button event. "cur" is the currency field.
Sub Click(Source As Button)
'On Error Goto errhandle
Dim work As New notesuiworkspace
Dim uidoc As notesuidocument
Dim doc As notesdocument
Dim item As String, weight As String
Dim qty As String, price As String
Dim sbtotal As String
Dim gtotal As String
Set uidoc = work.currentdocument
Set doc =uidoc.Document
item = uidoc.FieldGetText("Item")
qty = uidoc.FieldGetText("Qty")
price = uidoc.FieldGetText("Price")
cur = uidoc.FieldGetText("cur")
sbtotal= uidoc.FieldGetText("SubTotal")
Call uidoc.Refresh
'weight = uidoc.FieldGetText("W_Qty")
'adj = uidoc.fieldGetText("Adj")
remark = uidoc.FieldGetText("Remarks")
If item = "" Or qty = "" Or price = "" Then
Msgbox "Please complete the data entry ", 16, "Error - Incomplete Data Entry"
Exit Sub
End If
recordNo = uidoc.fieldgettext("ww")
If recordNo = "" Then
recordNumber = 0
Else
pos = Instr(recordNo,";")
If pos > 0 Then
number = Right(recordNo , pos -1)
Else
number = Left(recordNo , pos +1)
End If
recordNumber = Cint(number)
End If
recordNumber = recordNumber + 1
'to append text
Call uidoc.FieldAppendText("no" ,";" & Cstr(recordNumber))
Call uidoc.FieldAppendText("Item1" ,";" & item)
Call uidoc.FieldAppendText("Q1" , ";" & Cstr(qty))
Call uidoc.FieldAppendText("amt" , ";" & Cdbl(price))
Call uidoc.FieldAppendText("C1" , ";" & Cstr(cur))
Call uidoc.FieldAppendText("TSubTotal" , ";" & Cdbl(sbtotal))
'clear entering data
uidoc.FieldClear("Remarks")
uidoc.FieldClear("Item")
uidoc.FieldClear("Qty")
uidoc.FieldClear("Price")
'uidoc.FieldClear("W_Qty")
Call uidoc.FieldSetText("SubTotal","0.00")
uidoc.refresh
Dim subtotal As Double
subtotal = 0
Forall stotal In doc.TSubTotal
If stotal <> "" Then
subtotal = subtotal + Cdbl(stotal)
End If
End Forall
total = subtotal '+ Cdbl(curdoc.SubTotal(0))
Call uidoc.FieldSetText("GrandTotal",Format(total,"#,##0.00"))
uidoc.refresh
uidoc.gotofield"Item"
End Sub
Please help me. Thanks.
Create a new hidden field called selectedCurrency. The initial value of this field should be empty.
In your Add button code, you need to first check selectedCurrency, and if it is blank you should set it equal to cur.
Then, also in the code for the Add button, you need to compare selectedCurrency and cur, and if they are not equal you should display your message box.
I'd fix the currency outside the code for the Add button, and also make it required before Add can be started.