I'm trying to use IEdmEnumeratorVariable5::SetVar to update some file card variables based on user input into a windows form. My code executes, there are no error messages, the file is checked out and checked back in and the appropriate comment is added to the history; however the variables on the card are not updated.
I have verified by stepping through code at runtime that all variables are populated with the correct (as expected) data. The SetVar procedures all go off without a hitch, but the variables on the data card do not change value - even manually refreshing the folder view has no effect.
Below is my code.
This is an add-in application, written as a class-library project in VB using VS Community 2015, with target framework .NET 4.0.
In efforts to make this question more concise; immediately below I've included just the snippet of code doing the set variables work, then I've also included more code so you can get the whole picture if needed.
JUST THE TIP :
This is the code doing the set variables work:
Dim UserManager As IEdmUserMgr5 = .SourceVault
Dim User As IEdmUser5 = UserManager.GetLoggedInUser
CardComment = UserComment & CardComment
CardDate = Today().ToString("yyMMdd", Globalization.CultureInfo.InvariantCulture)
CardBy = User.Name
CardDisposition = UserDisposition
CardVariables.SetVar(DispositionVariable, "#", CardDisposition)
CardVariables.SetVar(CommentVariable, "#", CardComment)
CardVariables.SetVar(ByVariable, "#", CardBy)
CardVariables.SetVar(DateVariable, "#", CardDate)
CardVariables.Flush()
THE BROADER STROKES :
Class module level variables:
Private Structure CommandInfo
Dim SourceVault As IEdmVault11
Dim SourceCommand As EdmCmd
Dim SourceSelection As System.Array
Dim TargetTemplate As System.String
Dim VerifiedPaths As List(Of String)
End Structure
Private ReceivedCommand As CommandInfo
OnCmd procedure (caller):
Public Sub OnCmd(ByRef poCmd As EdmCmd,
ByRef ppoData As System.Array) Implements IEdmAddIn5.OnCmd
Dim CommandToRun As MenuCommand
Try
With ReceivedCommand
.SourceVault = poCmd.mpoVault
.SourceCommand = poCmd
.SourceSelection = ppoData
'Get the command structure for the command ID
Select Case poCmd.meCmdType
Case EdmCmdType.EdmCmd_Menu
CommandToRun = AvailableCommands(.SourceCommand.mlCmdID)
Case EdmCmdType.EdmCmd_CardButton
Select Case True
Case poCmd.mbsComment.ToString.ToUpper.Contains("DISPOSITION")
DispositionRequest()
Case Else : Exit Sub
End Select
Case Else : Exit Sub
End Select
'...... (End Try, End Sub, Etc.)
DispositionRequest procedure (callee):
Private Sub DispositionRequest()
Dim UserDisposition As String
Using Disposition As New DispositionForm
With Disposition
If Not .ShowDialog() = System.Windows.Forms.DialogResult.OK Then Exit Sub
Select Case True
Case .Approve.Checked
UserDisposition = "Approved"
Case .Reject.Checked
UserDisposition = "Rejected"
Case Else : Exit Sub
End Select
End With
End Using
Dim UserComment As String
Using Explanation As New DispositionExplanation
With Explanation
If Not .ShowDialog() = System.Windows.Forms.DialogResult.OK Then Exit Sub
If .ListView1.Items.Count > 0 Then
'do some stuff not relevant to this question...
End If
UserComment = .Comments.Text
End With
End Using
'This next procedure just gets a list of paths from ReceivedCommand.SourceSelection - which is just the ppoData argument from the OnCmd procedure - see code block above!
Dim RequestPaths As List(Of String) = GetSelectedFilePaths()
For Each Path As String In RequestPaths
With ReceivedCommand
Dim RequestFile As IEdmFile5 = .SourceVault.GetFileFromPath(Path)
Dim ParentFolder As IEdmFolder6 = .SourceVault.GetFolderFromPath(System.IO.Path.GetDirectoryName(Path))
Dim UnlockLater As Boolean = False
If Not RequestFile.IsLocked Then
UnlockLater = True
RequestFile.LockFile(ParentFolder.ID, .SourceCommand.mlParentWnd, CInt(EdmLockFlag.EdmLock_Simple))
End If
Dim CardVariables As IEdmEnumeratorVariable5 = RequestFile.GetEnumeratorVariable
'We allow users to re-disposition a request so we want to keep any previous disposition information so it is not lost
Dim CardComment As String = String.Empty
Dim CardBy As String = String.Empty
Dim CardDate As String = String.Empty
Dim CardDisposition As String = String.Empty
Dim Success As Boolean
Const CommentVariable As String = "DispComm"
Const ByVariable As String = "DisposedBy"
Const DateVariable As String = "DisposedDate"
Const DispositionVariable As String = "Disposition"
Success = CardVariables.GetVar(DispositionVariable, "#", CardDisposition)
If Success Then
Success = CardVariables.GetVar(CommentVariable, "#", CardComment)
If Success Then Success = CardVariables.GetVar(ByVariable, "#", CardBy)
If Success Then Success = CardVariables.GetVar(DateVariable, "#", CardDate)
If Success Then CardComment = "Previously dispositioned as: """ & CardDisposition & """ by: " & CardBy & " on: " & CardDate & vbNewLine &
"---------Previous disposition explanation---------" & vbNewLine & CardComment
End If
Dim UserManager As IEdmUserMgr5 = .SourceVault
Dim User As IEdmUser5 = UserManager.GetLoggedInUser
CardComment = UserComment & CardComment
CardDate = Today().ToString("yyMMdd", Globalization.CultureInfo.InvariantCulture)
CardBy = User.Name
CardDisposition = UserDisposition
CardVariables.SetVar(DispositionVariable, "#", CardDisposition)
CardVariables.SetVar(CommentVariable, "#", CardComment)
CardVariables.SetVar(ByVariable, "#", CardBy)
CardVariables.SetVar(DateVariable, "#", CardDate)
CardVariables.Flush()
If UnlockLater Then RequestFile.UnlockFile(lParentWnd:= .SourceCommand.mlParentWnd,
bsComment:="Dispositioned as " & CardDisposition,
lEdmUnlockFlags:=0)
.SourceVault.RefreshFolder(ParentFolder.LocalPath)
End With
Next
End Sub
From the documentation:
bsCfgName : Name of configuration or layout to which to store the variable value; empty string for folders and file types that do not support configurations
I was working with a virtual file, which did not support configurations.
I saw a C example working with a virtual file and they were passing null references, so I reread the documentation and saw that excerpt above, so I changed my code from "#" to String.Empty for the mboconfiguration argument and now it is working!
CardVariables.SetVar(DispositionVariable, String.Empty, CardDisposition)
CardVariables.SetVar(CommentVariable, String.Empty, CardComment)
CardVariables.SetVar(ByVariable, String.Empty, CardBy)
CardVariables.SetVar(DateVariable, String.Empty, CardDate)
CardVariables.Flush()
Related
Module Module1
Dim database As New Dictionary(Of String, String)
Dim ulist As New List(Of String)
Dim plist As New List(Of String)
Dim newname As String
Dim passw As String
Sub main()
menu() '
End Sub
Sub menu()
Console.WriteLine("type 1, 2 or 3")
Console.WriteLine("1 : create a new account")
Console.WriteLine("2: log in ")
Console.WriteLine("3 : quit program")
Dim choice As String
choice = Console.ReadLine()
If choice = "1" Then
create()
ElseIf choice = "2" Then
login()
ElseIf choice = "3" Then
Console.WriteLine("quitting...")
Console.Clear()
End If
End Sub
Sub login()
Dim unamever As String
Dim passwvari
Dim veri3 As Boolean = False
While veri3 = False
Console.WriteLine("please enter you username")
unamever = Console.ReadLine()
If ulist.Contains(unamever) Then
Console.WriteLine("please enter your password : ")
passwvari = Console.ReadLine()
If plist.Contains(passwvari) Then
Console.WriteLine("logging you in...")
veri3 = True
Else
Console.WriteLine("password incorrect try again")
veri3 = False
End If
Else
Console.WriteLine("username not registered try again")
veri3 = False
End If
End While
End Sub
Sub create()
Dim veri As Boolean = False
Dim attempts As Integer = 1
Do Until veri = True
Console.WriteLine("enter a new username")
newname = Console.ReadLine()
If ulist.Contains(newname) Then
Console.WriteLine("that username is already taken, try again")
attempts = attempts + 1
veri = False
Else
ulist.Add(newname)
Console.WriteLine("your new username has been stored")
notused()
veri = True
database.Add(newname, passw)
Console.WriteLine("succes you have made an account you username :" & newname & " and password: " & passw)
FileOpen(1, "C:\Users\iivix\OneDrive\Documents\A LEVEL\passws.txt", OpenMode.Output)
PrintLine(1, newname & passw)
End If
If attempts > 4 Then
Console.WriteLine("you have had more than 3 tries, BYE")
Console.Clear()
End If
Loop
End Sub
Sub notused()
Dim veri2 As Boolean = False
While veri2 = False
Console.WriteLine("create a password " & newname)
passw = Console.ReadLine
Dim passwlen = Len(passw)
If passwlen > 12 Then
Console.WriteLine("your password has been stored ")
plist.Add(passw)
veri2 = True
Else
Console.WriteLine("try again password must be greater than 12 characters")
veri2 = False
End If
End While
End Sub
End Module
This code is for a login system, I am a vb beginner and this is my code so far I have come across a problem: why aren't the usernames being stored when I try to log in later, how can I fix this? I want the user to be able to log back into an account when it is created another problem when writing usernames and passwords to a text file the new username overwrites the last, I want the usernames to be consecutively listed along with passwords'
BTW this isn't homework, its a beginners programming challenge
I have updated your code to use .net methods rather than obsolete VB6 methods. I made the LoginPath a Module level variable so it can be seen my all the methods in the Module. I am using a Dictionary rather than your 2 List(Of String)s. This way the username is the key and the password in the value. Dictionary lookup is very fast.
The first thing to do is to read the file and and fill the dictionary. If the file doesn't yet exist the user is informed.
The Create method changes a bit with the use of the Dictionary. I used the .net File class to write to the text file.
File.AppendAllLines(LoginPath, {$"{newname},{passw}"})
This is a very clever method. If the file doesn't exist, it creates it. It opens the file writes to the file and closes it. The first parameter is the path. The second parameter is what to write to the file, a String array. Notice the method names ends with AllLines, plural. The outer braces indicate that this is an array. Our array has only one element. I used an interpolated string indicated by the $ preceding the string. We can then insert variables directly into the string surrounded by braces. The comma is a literal in the string. We use the comma as a delimiter when the string is split into name and password.
Private LoginPath As String = "C:\Users\iivix\OneDrive\Documents\A LEVEL\passws.txt"
Private LoginDict As New Dictionary(Of String, String)
Sub Main()
ReadLoginFileAndFillDictionary()
menu()
Console.ReadKey()
End Sub
Private Sub Menu() 'Names of Subs, Functions etc. should begin with capital letters
Console.WriteLine("type 1, 2 or 3")
Console.WriteLine("1 : create a new account")
Console.WriteLine("2: log in ")
Console.WriteLine("3 : quit program")
Dim choice As String
choice = Console.ReadLine()
If choice = "1" Then
Create()
ElseIf choice = "2" Then
Login()
ElseIf choice = "3" Then
Console.WriteLine("quitting...")
Environment.Exit(0)
End If
End Sub
Private Sub Create()
Dim veri As Boolean 'Default value is False, value types initialize automatically
Dim attempts As Integer
Dim newname As String = ""
Dim passw As String = ""
Do Until veri = True
Console.WriteLine("enter a new username")
newname = Console.ReadLine()
If LoginDict.ContainsKey(newname) Then 'Searches the Keys in the Dictionary and returns True or False
Console.WriteLine("that username is already taken, try again")
attempts += 1 'new syntax for updating the value of a variable, saves a bit of typing
Else
veri = True
End If
If attempts > 4 Then
Console.WriteLine("you have had more than 3 tries, BYE")
Console.Clear()
Environment.Exit(0) 'To end the application
End If
Loop
veri = False 'You can use the same variable just reset its value
While veri = False
Console.WriteLine("create a password " & newname)
passw = Console.ReadLine
Dim passwlen = passw.Length 'Don't use the old VB6 Len
If passwlen > 12 Then
LoginDict.Add(newname, passw) 'Here is where the new user is added to the Dictionary
veri = True
Else
Console.WriteLine("try again, password must be greater than 12 characters")
End If
End While
Console.WriteLine("your new username and password have been stored")
Console.WriteLine("succes, you have made an account your username :" & newname & " and password: " & passw)
File.AppendAllLines(LoginPath, {$"{newname},{passw}"}) 'Adds the new user to the text file
End Sub
Private Sub Login()
Dim unamever As String = ""
Dim passwvari As String = ""
Dim veri As Boolean 'You don't need a different name for a variable in a another method.
While veri = False
Console.WriteLine("please enter you username")
unamever = Console.ReadLine()
If LoginDict.ContainsKey(unamever) Then 'Searches the Keys in the Dictionary and returns True or False
passwvari = LoginDict(unamever) 'Gets the value associated with the username
Console.WriteLine("please enter your password : ")
If passwvari = Console.ReadLine Then 'Compares the value found in the Dictionary to the string entered by the user.
Console.WriteLine("logging you in...")
veri = True
Else
Console.WriteLine("password incorrect, try again")
End If
Else
Console.WriteLine("username not registered, try again")
End If
End While
End Sub
Private Sub ReadLoginFileAndFillDictionary()
If File.Exists(LoginPath) Then
Dim lines = File.ReadAllLines(LoginPath) 'Read the file into an array of lines
For Each line In lines
Dim splits = line.Split(","c) 'Split each line by the comma into an array of 2 strings
LoginDict.Add(splits(0), splits(1)) 'The first element is the username and the second element is the password.
Next
Else
Console.WriteLine("There are currently no registered users. Please begin with Option 1.")
End If
End Sub
In a real application you would NEVER store passwords as plain text.
I'm currently having problems trying to delete a line from a file and replace that line with different text (overwrite the line)
The code initially starts by extracting file contents to find the
DepartmentDetails which can be used to find DepartmentBudget and subtract AmountDue and then create a new DepartmentDetails with the new budget
Once this is complete the code will add the N̳e̳w̳ DepartmentDetails which will leave the code with having the O͟l͟d͟ and the N̳e̳w̳ DepartmentDetails in the same folder.
The code should then delete the O͟l͟d͟ DepartmentDetails from the file making the N̳e̳w̳ DepartmentBudget take it's place. i.e. Overwrite the O͟l͟d͟ DepartmentDetails with the new one.
The problem is that the code does not delete the O͟l͟d͟ DepartmentBudget but adds a line space in between the O͟l͟d͟ and N̳e̳w̳ instead.
Private Sub BtnBillDept_Click(sender As Object, e As EventArgs) Handles BtnBillDept.Click
Dim DepartmentStore As New Department
Dim Order() As String = File.ReadAllLines(Dir$("OrderDetails.Txt"))
Dim OrderID As String = TxtOrderID.Text
Dim AmountDue As String = TxtAmountDue.Text
Dim DeptID As String = (Trim(Mid(Order(OrderID), 5, 4)))
Dim DepartmentDetails() As String = File.ReadAllLines(Dir$("DepartmentDetails.Txt"))
Dim DepartmentBudget As String = (Trim(Mid(DepartmentDetails(DeptID), 35, 6)))
Dim FormattedBudget As String = FormatCurrency(DepartmentBudget, 2)
Dim YesNo As String
Dim sw As New StreamWriter("DepartmentDetails.txt", True)
DepartmentBudget = FormattedBudget - AmountDue
DepartmentStore.DepartmentID = LSet(DeptID, 4)
DepartmentStore.DepartmentHead = LSet((Trim(Mid(DepartmentDetails(DeptID), 5, 20))), 20)
DepartmentStore.DepartmentName = LSet((Trim(Mid(DepartmentDetails(DeptID), 25, 10))), 10)
DepartmentStore.DepartmentBudget = LSet(DepartmentBudget, 9)
DeptID = UBound(DepartmentDetails)
DepartmentDetails(DeptID) = ""
File.WriteAllLines("DepartmentDetails", DepartmentDetails)
sw.WriteLine(DepartmentStore.DepartmentID & DepartmentStore.DepartmentHead & DepartmentStore.DepartmentName & DepartmentStore.DepartmentBudget)
sw.Close()`
'***********************Having Problems Here***********************
DepartmentDetails = File.ReadAllLines(Dir$("DepartmentDetails.Txt"))
DepartmentDetails(DeptID) = ""
File.WriteAllLines("DepartmentDetails", DepartmentDetails)
'************************Having Problems Here**************************
YesNo = MsgBox("Department has been billed. Would you like to delete the bill?", vbYesNo)
If YesNo = vbYes Then
End If
End Sub
Who decided that this text file would be formatted with fixed length fields? All this trimming and padding could be avoided with a simple comma delimited file or an xml file or a database where it really belongs.
Code is not tested. Comments and explanations in-line.
'I assume you have a class that looks something like this
'This uses automatic properties to save you having to
'type a getter, setter and backer field (the compiler adds these)
Public Class Department
Public Property DepartmentID As Integer
Public Property DepartmentHead As String
Public Property DepartmentName As String
Public Property DepartmentBudget As Decimal
End Class
Private Sub BtnBillDept_Click(sender As Object, e As EventArgs) Handles BtnBillDept.Click
Dim DepartmentStore As New Department
'Drag an OpenFileDialog from the ToolBox to your form
'It will appear in the lower portion of the design window
Dim MyFilePath As String = ""
OpenFileDialog1.Title = "Select OrderDetails.Txt"
If OpenFileDialog1.ShowDialog = DialogResult.OK Then
MyFilePath = OpenFileDialog1.FileName
End If
Dim Order() As String = File.ReadAllLines(MyFilePath)
'Changed data type, you use OrderID as an index for the Order array so it must be an Integer
Dim OrderID As Integer
'TryParse will check if you have a valid interger and fill OrderID variable
If Not Integer.TryParse(TxtOrderID.Text, OrderID) Then
MessageBox.Show("Please enter a valid Order ID.")
Return
End If
'EDIT per comment by Codexer
If OrderID > Order.Length - 1 Then
MessageBox.Show("Order Number is too high")
Return
End If
Dim AmountDue As Decimal
If Decimal.TryParse(TxtAmountDue.Text, AmountDue) Then
MessageBox.Show("Please enter a valid Amount Due")
Return
End If
'I hope you realize that the first index in Order is zero
'Mid is an old VB6 method around for compatibility
'Use the .net Substring (startIndex As Integer, length As Integer)
'The indexes in the string start with zero
Dim DeptID As Integer = CInt(Order(OrderID).Substring(5, 4).Trim) '(Trim(Mid(Order(OrderID), 5, 4)))
OpenFileDialog1.Title = "Select DepartmentDetails.txt"
If OpenFileDialog1.ShowDialog = DialogResult.OK Then
MyFilePath = OpenFileDialog1.FileName
End If
Dim DepartmentDetails() As String = File.ReadAllLines(MyFilePath)
Dim DepartmentBudget As Decimal = CDec(DepartmentDetails(DeptID).Substring(35, 6).Trim) '(Trim(Mid(DepartmentDetails(DeptID), 35, 6)))
'You don't need to format anything until you want to display it
'Dim FormattedBudget As String = FormatCurrency(DepartmentBudget, 2)
'A MessageBox returns a DialogResult
Dim YesNo As DialogResult
Dim sw As New StreamWriter(MyFilePath, True)
'Shorcut way to write DepartmentBudget - AmountDue
DepartmentBudget -= AmountDue
'Set the property in the class with the proper data type
DepartmentStore.DepartmentID = DeptID
'Then prepare a string for the writing to the fil
Dim PaddedID = CStr(DeptID).PadLeft(4)
'The .net replacement for LSet is .PadLeft
DepartmentStore.DepartmentHead = DepartmentDetails(DeptID).Substring(5, 20).Trim.PadLeft(20)
DepartmentStore.DepartmentName = DepartmentDetails(DeptID).Substring(25, 10).Trim.PadLeft(20)
'Set the property in the class with the proper data type
DepartmentStore.DepartmentBudget = DepartmentBudget
'Then prepare a string for the writing to the fil
Dim PaddedBudget = CStr(DepartmentBudget).PadLeft(9)
sw.WriteLine(PaddedID & DepartmentStore.DepartmentHead & DepartmentStore.DepartmentName & PaddedBudget)
sw.Close()
'***********************Having Problems Here***********************
'This is using the path from the most recent dialog
DepartmentDetails = File.ReadAllLines(MyFilePath)
'Here you are changing the value of one of the elements in the DepartmentDetails array
DepartmentDetails(DeptID) = ""
'Public Shared Sub WriteAllLines (path As String, contents As String())
'The string "DepartmentDetails" is not a path
File.WriteAllLines(MyFilePath, DepartmentDetails)
'************************Having Problems Here**************************
YesNo = MessageBox.Show("Department has been billed. Would you like to delete the bill?", "Delete Bill?", MessageBoxButtons.YesNo)
If YesNo = DialogResult.Yes Then
End If
End Sub
I am trying to write a string to a .csv file, but unable to get it to display.
I have managed to do it in VBA, but when writing in VB.net it's not working.
I first create the file and set the headers for each column. After this I am getting information on each required attribute and writing it to a string s.
All i want to do now is write the string to the .csv file so that each attribute is in the right column under the right header.
Each time the string s simply needs to be on a new row.
This is what I have so far (I have cut out some bits of code so some syntax may look incorrect). What am i doing wrong or missing?
Sub Main()
Dim sOutput As String
' Create a header for the output file
sOutput = ("Level,Occurrence Name,Reference Name,Object type, Visibility, Path" & vbLf)
If Occs.Count > 0 Then
For i = 1 To Occs.Count
iLevel = 0
curOcc = Occs.Item(i)
GetOccurrenceData(curOcc, sOutput, oSel, False, iLevel)
Next
End If
' Write the output string to a file
Dim sPath As String
Dim bWrite As Boolean
sPath = ("C:\temp\data3.csv")
bWrite = WriteFile(sPath, sOutput)
End Sub
Sub GetOccurrenceData(curOcc As VPMOccurrence, s As String, sel As Selection, ByVal bParentHidden As Boolean, ByVal iParentLevel As Integer)
'CODE TO GET DATA REMOVED AS IRRELEVANT
' Append the output string with the data for the current occurrence.
s = (s & curLevel & "," & sName & "," & sRefName & "," & sType & "," & sVisibility & vbLf)
' Repeat this data gathering procedure on any children the current occurrence may have.
Occs = curOcc.Occurrences
If Occs.Count > 0 Then
For i = 1 To Occs.Count
GetOccurrenceData(Occs.Item(i), s, sel, bChildrenInheritNoShow, curLevel)
Next
End If
In GetOccurrenceData you pass in a string and change it in the method, but you did not pass it in as a ByRef so anything done to the string in the method stays in the method.
Change the header of your method to read
Sub GetOccurrenceData(curOcc As VPMOccurrence,ByRef s As String, sel As Selection, ByVal bParentHidden As Boolean, ByVal iParentLevel As Integer)
I would however recommend using a StringBuilder to accomplish what you are doing.
Like This:
Sub Main()
Dim sb As New Text.StringBuilder()
sb.AppendLine("Level,Occurrence Name,Reference Name,Object type, Visibility, Path")
If Occs.Count > 0 Then
For i = 1 To Occs.Count
iLevel = 0
curOcc = Occs.Item(i)
GetOccurrenceData(curOcc, sb, oSel, False, iLevel)
Next
End If
' Write the output string to a file
Dim sPath As String
Dim bWrite As Boolean
sPath = ("C:\temp\data3.csv")
bWrite = WriteFile(sPath, sb.ToString())
End Sub
Sub GetOccurrenceData(curOcc As VPMOccurrence, sb As Text.StringBuilder, sel As Selection, ByVal bParentHidden As Boolean, ByVal iParentLevel As Integer)
'CODE TO GET DATA REMOVED AS IRRELEVANT
' Append the output string with the data for the current occurrence.
sb.Append(curLevel).Append(",").Append(sName).Append(",").Append(sRefName).Append(",").Append(sType).Append(",").AppendLine(sVisibility)
' Repeat this data gathering procedure on any children the current occurrence may have.
Occs = curOcc.Occurrences
If Occs.Count > 0 Then
For i = 1 To Occs.Count
GetOccurrenceData(Occs.Item(i), sb, sel, bChildrenInheritNoShow, curLevel)
Next
End If
End Sub
I am not very well-versed in Reflection, but I have been working on this bit of code for a few days trying to obtain the values of class properties. I am using an API to find the values inside of cron jobs managed by the program VisualCron.
I'll explain the structure a bit. Each cron job has several tasks inside of it which have their own settings. The settings are stored in properties inside the TaskClass class that are declared like so:
Public Property <propertyname> As <classname>
Each property is tied to its own class, so for instance there is an Execute property inside TaskClass which is declared like this:
Public Property Execute As TaskExecuteClass
Inside TaskExecuteClass are the properties that hold the values I need. With the below block of code I have been able to retrieve the property values of all types EXCEPT strings. Coincidentally, the string values are the only values I need to get.
I know there must be something wrong with what I've written causing this because I can't find anyone with a similar issue after lots and lots of searching. Can anyone help me please?
Dim strAdd As String = ""
For Each t As VisualCronAPI.Server In vcClient.Servers.GetAll()
For Each f As VisualCron.JobClass In t.Jobs.GetAll
For Each s As VisualCron.TaskClass In f.Tasks
Dim propVal As Object
Dim propInfo As PropertyInfo() = s.GetType().GetProperties()
For i As Integer = 0 To propInfo.Length - 1
With propInfo(i)
If s.TaskType.ToString = propInfo(i).Name.ToString Then
Dim asm As Assembly = Assembly.Load("VisualCron")
Dim typeName As String = String.Format("VisualCron.{0}", propInfo(i).PropertyType.Name)
Dim tp As Type = asm.GetType(typeName)
Dim construct As ConstructorInfo = tp.GetConstructor(Type.EmptyTypes)
Dim classInst As Object = construct.Invoke(Nothing)
Dim classProps As PropertyInfo() = classInst.GetType().GetProperties()
For h As Integer = 0 To classProps.Length - 1
With classProps(h)
If .GetIndexParameters().Length = 0 Then
propVal = .GetValue(classInst, Nothing)
If Not propVal Is Nothing Then
strAdd = f.Name & " - " & s.Name & " - " & .Name & " - " & propVal.ToString
End If
End If
If strAdd <> "" Then
ListBox1.Items.Add(strAdd)
End If
End With
Next
End If
End With
Next
Next s
Next f
Next t
I solved my own problem, albeit in a crappy way. This is probably incredibly inefficient, but speed isn't a necessity in my particular case. Here is the code that works:
Dim strAdd As String = ""
For Each t As VisualCronAPI.Server In vcClient.Servers.GetAll()
For Each f As VisualCron.JobClass In t.Jobs.GetAll
For Each s As VisualCron.TaskClass In f.Tasks
Dim propVal As Object
Dim propInfo As PropertyInfo() = s.GetType().GetProperties()
For i As Integer = 0 To propInfo.Length - 1
With propInfo(i)
If s.TaskType.ToString = propInfo(i).Name.ToString Then
Dim asm As Assembly = Assembly.Load("VisualCron")
Dim typeName As String = String.Format("VisualCron.{0}", propInfo(i).PropertyType.Name)
Dim tp As Type = asm.GetType(typeName)
Dim construct As ConstructorInfo = tp.GetConstructor(Type.EmptyTypes)
Dim classInst As Object = construct.Invoke(Nothing)
Dim classProps As PropertyInfo() = classInst.GetType().GetProperties()
For h As Integer = 0 To classProps.Length - 1
With classProps(h)
If .GetIndexParameters().Length = 0 Then
propVal = .GetValue(CallByName(s, propInfo(i).Name.ToString, [Get]), Nothing)
If Not propVal Is Nothing Then
If propVal.ToString.Contains("\\server\") Or propVal.ToString.Contains("\\SERVER\") Then
strAdd = f.Name & " - " & s.Name & " - " & .Name & " - " & propVal.ToString
ListBox1.Items.Add(strAdd)
End If
End If
End If
End With
Next
End If
End With
Next
Next s
Next f
Next t
The piece of code that made the difference was the
classProps(h).GetValue(CallByName(s, propInfo(i).Name.ToString, [Get]), Nothing)
line.
If there are any suggestions for improving this code - I'm assuming that I've still got a lot of mistakes in here - then please comment for the future viewers of this answer and so I can adjust my code and learn more about how all of this works.
Is there any way, in either VBA or C# code, to get a list of the existing macros defined in a workbook?
Ideally, this list would have a method definition signatures, but just getting a list of the available macros would be great.
Is this possible?
I haven't done vba for Excel in a long time, but if I remember well, the object model for the code was inaccessible through scripting.
When you try to access it, you receive the following error.
Run-time error '1004':
Programmatic access to Visual Basic Project is not trusted
Try:
Tools | Macro | Security |Trusted Publisher Tab
[x] Trust access to Visual Basic Project
Now that you have access to the VB IDE, you could probably export the modules and make a text search in them, using vba / c#, using regular expressions to find sub and function declarations, then delete the exported modules.
I'm not sure if there is an other way to do this, but this should work.
You can take a look the following link, to get started with exporting the modules.
http://www.developersdex.com/vb/message.asp?p=2677&ID=%3C4FCD0AE9-5DCB-4A96-8B3C-F19C63CD3635%40microsoft.com%3E
This is where I got the information about giving thrusted access to the VB IDE.
Building on Martin's answer, after you trust access to the VBP, you can use this set of code to get an array of all the public subroutines in an Excel workbook's VB Project. You can modify it to only include subs, or just funcs, or just private or just public...
Private Sub TryGetArrayOfDecs()
Dim Decs() As String
DumpProcedureDecsToArray Decs
End Sub
Public Function DumpProcedureDecsToArray(ByRef Result() As String, Optional InDoc As Excel.Workbook) As Boolean
Dim VBProj As Object
Dim VBComp As Object
Dim VBMod As Object
If InDoc Is Nothing Then Set InDoc = ThisWorkbook
ReDim Result(1 To 1500, 1 To 4)
DumpProcedureDecsToArray = True
On Error GoTo PROC_ERR
Set VBProj = InDoc.VBProject
Dim FuncNum As Long
Dim FuncDec As String
For Each VBComp In VBProj.vbcomponents
Set VBMod = VBComp.CodeModule
For i = 1 To VBMod.countoflines
If IsSubroutineDeclaration(VBMod.Lines(i, 1)) Then
FuncDec = RemoveBlanksAndDecsFromSubDec(RemoveAsVariant(VBMod.Lines(i, 1)))
If LCase(Left(VBMod.Lines(i, 1), Len("private"))) <> "private" Then
FuncNum = FuncNum + 1
Result(FuncNum, 1) = FindToLeftOfString(InDoc.Name, ".") '
Result(FuncNum, 2) = VBMod.Name
Result(FuncNum, 3) = GetSubName(FuncDec)
Result(FuncNum, 4) = VBProj.Name
End If
End If
Next i
Next VBComp
PROC_END:
Exit Function
PROC_ERR:
GoTo PROC_END
End Function
Private Function RemoveCharFromLeftOfString(TheString As String, RemoveChar As String) As String
Dim Result As String
Result = TheString
While LCase(Left(Result, Len(RemoveChar))) = LCase(RemoveChar)
Result = Right(Result, Len(Result) - Len(RemoveChar))
Wend
RemoveCharFromLeftOfString = Result
End Function
Private Function RemoveBlanksAndDecsFromSubDec(TheLine As String) As String
Dim Result As String
Result = TheLine
Result = RemoveCharFromLeftOfString(Result, " ")
Result = RemoveCharFromLeftOfString(Result, " ")
Result = RemoveCharFromLeftOfString(Result, "Public ")
Result = RemoveCharFromLeftOfString(Result, "Private ")
Result = RemoveCharFromLeftOfString(Result, " ")
RemoveBlanksAndDecsFromSubDec = Result
End Function
Private Function RemoveAsVariant(TheLine As String) As String
Dim Result As String
Result = TheLine
Result = Replace(Result, "As Variant", "")
Result = Replace(Result, "As String", "")
Result = Replace(Result, "Function", "")
If InStr(1, Result, "( ") = 0 Then
Result = Replace(Result, "(", "( ")
End If
RemoveAsVariant = Result
End Function
Private Function IsSubroutineDeclaration(TheLine As String) As Boolean
If LCase(Left(RemoveBlanksAndDecsFromSubDec(TheLine), Len("Function "))) = "function " Or LCase(Left(RemoveBlanksAndDecsFromSubDec(TheLine), Len("sub "))) = "sub " Then
IsSubroutineDeclaration = True
End If
End Function
Private Function GetSubName(DecLine As String) As String
GetSubName = FindToRightOfString(FindToLeftOfString(DecLine, "("), " ")
End Function
Function FindToLeftOfString(FullString As String, ToFind As String) As String
If FullString = "" Then Exit Function
Dim Result As String, ToFindPos As Integer
ToFindPos = InStr(1, FullString, ToFind, vbTextCompare)
If ToFindPos > 0 Then
Result = Left(FullString, ToFindPos - 1)
Else
Result = FullString
End If
FindToLeftOfString = Result
End Function
Function FindToRightOfString(FullString As String, ToFind As String) As String
If FullString = "" Then Exit Function
Dim Result As String, ToFindPos As Integer
ToFindPos = InStr(1, FullString, ToFind, vbTextCompare)
Result = Right(FullString, Len(FullString) - ToFindPos + 1 - Len(ToFind))
If ToFindPos > 0 Then
FindToRightOfString = Result
Else
FindToRightOfString = FullString
End If
End Function