I run this little piece of code to do a kind of activity log window.
Sub writetolog(i As String)
Try
'outfile.Write(DateTime.Now.ToString("mm/dd/yyyy - H:mm:ss:fffffff") & "--->" & i & vbCrLf)
Console.WriteLine(DateTime.Now.ToString("HH:mm:ss:ff") & " - " & i)
If String.IsNullOrWhiteSpace(i) = False Then LogLB.Items.Add(DateTime.Now.ToString("[" & "MM/dd/yy - HH:mm:ss:ff") & "] -- " & i) 'Else MsgBox(i & " is nothing!")
If LogLB.Items.Count >= 100 Then LogLB.Items.RemoveAt(0)
If LogLB.Items.Count > 0 Then LogLB.SelectedIndex = LogLB.Items.Count - 1
Catch ex As Exception
Console.Write(ex)
End Try
End Sub
So it works most of the time, but for some reason at seemingly random times I get a Null Exception and it points to the end of the line at
LogLB.Items.Count - 1
Why?
Related
I verified all the directory paths exist so I am completely at a loss here.
For Each i As Project.ImageryCaptureTask.FileProperties In t.FileCollection
Dim NewFilename As New FileInfo(Path.Combine(Root.FullName, i.LVItem.Text))
If NewFilename.Exists Then
' ...Things get done
Else
Try
i.FI.MoveTo(NewFilename.FullName) ' <- Error thrown here (obviously)
Catch IOEx As IOException
MsgBox(IOEx.Message & vbCr & vbCr & "Error renaming to " & NewFilename.FullName, vbOKOnly, IOEx.Source)
Catch Ex As Exception
MsgBox(Ex.Message & vbCr & vbCr & "Error renaming to " & NewFilename.FullName, vbOKOnly, IOEx.Source)
End Try
End If
Next
Edit
Sorry, I was trying to keep the question short and quick, but I failed to provide the key information about Root.FullName. Here is the snippet to show that.
' P.MainFolder.FullName is the DirectoryInfo instantiated from the FolderBrowserDialog
If Directory.Exists(P.MainFolder.FullName) Then
For Each t As Project.ImageryCaptureTask In P.TaskCollection
Dim SubFolder3DMapping As New DirectoryInfo(Path.Combine(P.MainFolder.FullName, (Val(t.TaskCreationDate) + t.OffsetDate).ToString & "_" & P.ProjectNumber & "_" & P.ProjectName & "_" & Project.ImageryCaptureTask.CapturingMethods.Aerial3DMapping.ToString.Insert(6, "_")))
Dim SubFolderPhotos As New DirectoryInfo(Path.Combine(P.MainFolder.FullName, (Val(t.TaskCreationDate) + t.OffsetDate).ToString & "_" & P.ProjectNumber & "_" & P.ProjectName & "_" & Project.ImageryCaptureTask.CapturingMethods.AerialPhotos.ToString.Insert(6, "_")))
Dim SubFolderVideos As New DirectoryInfo(Path.Combine(P.MainFolder.FullName, (Val(t.TaskCreationDate) + t.OffsetDate).ToString & "_" & P.ProjectNumber & "_" & P.ProjectName & "_" & Project.ImageryCaptureTask.CapturingMethods.AerialVideos.ToString.Insert(6, "_")))
If Not SubFolder3DMapping.Exists Then SubFolder3DMapping.Create()
If Not SubFolderPhotos.Exists Then SubFolderPhotos.Create()
If Not SubFolderVideos.Exists Then SubFolderVideos.Create()
Dim Root As DirectoryInfo = Nothing
Select Case True
Case t.CaptureMethod = Project.ImageryCaptureTask.CapturingMethods.Aerial3DMapping
Root = SubFolder3DMapping
Case t.CaptureMethod = Project.ImageryCaptureTask.CapturingMethods.AerialPhotos
Root = SubFolderPhotos
Case t.CaptureMethod = Project.ImageryCaptureTask.CapturingMethods.AerialVideos
Root = SubFolderVideos
End Select
For Each i As Project.ImageryCaptureTask.FileProperties In t.FileCollection
Dim NewFilename As New FileInfo(Path.Combine(Root.FullName, i.LVItem.Text))
If NewFilename.Exists Then
' This should not happen, but if it does it gets handled here.
Else
Try
i.FI.MoveTo(NewFilename.FullName)
Catch IOEx As IOException
MsgBox(IOEx.Message & vbCr & vbCr & "Error renaming to " & NewFilename.FullName, vbOKOnly, IOEx.Source)
Catch Ex As Exception
MsgBox(Ex.Message)
End Try
End If
Next
Next
End If
Here is a photo showing the results from the last attempt. Of the 33 files, 7 of them failed to be renamed:
The goal here is to rename the image files created during our drone flights. These flights are static, same amount of images at the same GPS locations, so we want to be able to reference any existing flight images so we can extract the filenames. The only dynamic part of the filenames are the first 8 characters (Date: yyyymmDD).
It turns out that the issue is that some of the filenames are too long and could not be renamed.
To get passed the issue with filename lengths being longer than MAX_PATH I used the following threads:
Resolving filename longer than MAX_PATH Exceptions > Forum
Deal with filename longer than MAX_PATH > Forum ... [ specifically the answer by Wolf5 ]
Is it possible to list the conditional formatting of all controls on a form? I'd like to be able to list out all existing conditions so that I can generate code to add/remove the existing conditions. I have inherited some complex forms and want to know what I'm dealing with and then generate some code to toggle the conditional formatting in areas where it is slowing down navigating a continuous form.
This Excel VBA example shows a similar format I'd like to have for Access.
https://stackoverflow.com/a/52204597/1898524
Only textboxes and comboboxes have Conditional Formatting.
There is no single property that can be listed to show a control's conditional formatting rule(s). Each rule has attributes that can be listed. Example of listing for a single specific control:
Private Sub Command25_Click()
Dim x As Integer
With Me.tbxRate
For x = 0 To .FormatConditions.Count - 1
Debug.Print .FormatConditions(x).BackColor
Debug.Print .FormatConditions(x).Expression1
Debug.Print .FormatConditions(x).FontBold
Next
End With
End Sub
The output for this example:
2366701
20
False
These are attributes for a rule that sets backcolor to red when field value is greater than 20.
Yes, code can loop through controls on form, test for textbox and combobox types, determine if there are CF rules and output attributes.
With some inspiration from #June7's example and some code from an article I found by Garry Robinson, I wrote a procedure that answers my question.
Here's the output in the Immediate window. This is ready to be pasted into a module. The design time property values are shown as a comment.
txtRowColor.FormatConditions.Delete
txtRowColor.FormatConditions.Add acExpression, acBetween, "[txtCurrent_Equipment_List_ID]=[txtEquipment_List_ID]"
With txtRowColor.FormatConditions.Item(txtRowColor.FormatConditions.Count-1)
.Enabled = True ' txtRowColor.Enabled=False
.ForeColor = 0 ' txtRowColor.ForeColor=-2147483640
.BackColor = 10092543 ' txtRowColor.BackColor=11850710
End With
You can test this sub from a click event on an open form. I was getting some false positives when checking the Boolean .Enabled property, even when I store the values into Boolean variables first. I don't know why and am researching it, but that is beyond the scope of this question.
Public Sub ListConditionalFormats(frmForm As Form)
' Show all the Textbox and Combobox controls on the passed form object (assuming the form is open).
' Output the FormatCondtion properties to the immediate window in a format that is
' suitable to be copied into VBA to recreate the conditional formatting.
' The design property value is shown as a comment on each condition property row.
Dim ctl As Control
Dim i As Integer
Dim bolControlEnabled As Boolean
Dim bolFormatEnabled As Boolean
On Error GoTo ErrorHandler
For Each ctl In frmForm.Controls
If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Then
With ctl
If .FormatConditions.Count > 0 Then
'Debug.Print vbCr & "' " & ctl.Name, "Count = " & .FormatConditions.Count
For i = 0 To .FormatConditions.Count - 1
' Generate code that can recreate each FormatCondition
Debug.Print ctl.Name & ".FormatConditions.Delete"
Debug.Print ctl.Name & ".FormatConditions.Add " & DecodeType(.FormatConditions(i).Type) _
& ", " & DecodeOp(.FormatConditions(i).Operator) _
& ", """ & Replace(.FormatConditions(i).Expression1, """", """""") & """" _
& IIf(Len(.FormatConditions(i).Expression2) > 0, ", " & .FormatConditions(i).Expression2, "")
Debug.Print "With " & ctl.Name & ".FormatConditions.Item(" & ctl.Name & ".FormatConditions.Count-1)"
bolControlEnabled = ctl.Enabled
bolFormatEnabled = .FormatConditions(i).Enabled
'Debug.Print bolControlEnabled <> bolFormatEnabled, bolControlEnabled, bolFormatEnabled
If bolControlEnabled <> bolFormatEnabled Then ' <- This sometimes fails. BS 2/9/2020
'If ctl.Enabled <> .FormatConditions(i).Enabled Then ' <- This sometimes fails. BS 2/9/2020
Debug.Print vbTab & ".Enabled = " & .FormatConditions(i).Enabled; Tab(40); "' " & ctl.Name & ".Enabled=" & ctl.Enabled
End If
If ctl.ForeColor <> .FormatConditions(i).ForeColor Then
Debug.Print vbTab & ".ForeColor = " & .FormatConditions(i).ForeColor; Tab(40); "' " & ctl.Name & ".ForeColor=" & ctl.ForeColor
End If
If ctl.BackColor <> .FormatConditions(i).BackColor Then
Debug.Print vbTab & ".BackColor = " & .FormatConditions(i).BackColor; Tab(40); "' " & ctl.Name & ".BackColor=" & ctl.BackColor
End If
If ctl.FontBold <> .FormatConditions(i).FontBold Then
Debug.Print vbTab & ".FontBold = " & .FormatConditions(i).FontBold; Tab(40); "' " & ctl.Name & ".FontBold=" & ctl.FontBold
End If
If ctl.FontItalic <> .FormatConditions(i).FontItalic Then
Debug.Print vbTab & ".FontItalic = " & .FormatConditions(i).FontItalic; Tab(40); "' " & ctl.Name & ".FontItalic=" & ctl.FontItalic
End If
If ctl.FontUnderline <> .FormatConditions(i).FontUnderline Then
Debug.Print vbTab & ".FontUnderline = " & .FormatConditions(i).FontUnderline; Tab(40); "' " & ctl.Name & ".FontUnderline=" & ctl.FontUnderline
End If
If .FormatConditions(i).Type = 3 Then ' acDataBar
Debug.Print vbTab & ".LongestBarLimit = " & .FormatConditions(i).LongestBarLimit
Debug.Print vbTab & ".LongestBarValue = " & .FormatConditions(i).LongestBarValue
Debug.Print vbTab & ".ShortestBarLimit = " & .FormatConditions(i).ShortestBarLimit
Debug.Print vbTab & ".ShortestBarValue = " & .FormatConditions(i).ShortestBarValue
Debug.Print vbTab & ".ShowBarOnly = " & .FormatConditions(i).ShowBarOnly
End If
Debug.Print "End With" & vbCr
Next
End If
End With
End If
Next
Beep
Exit_Sub:
Exit Sub
ErrorHandler:
MsgBox "Error #" & Err.Number & " - " & Err.Description & vbCrLf & "in procedure ListConditionalFormats" _
& IIf(Erl > 0, vbCrLf & "Line #: " & Erl, "")
GoTo Exit_Sub
Resume Next
Resume
End Sub
Function DecodeType(TypeProp As Integer) As String
' You heed this are there are 4 different ways to setup a CondtionalFormat
' https://vb123.com/listing-conditional-formats
Select Case TypeProp
Case 0
DecodeType = "acFieldValue"
Case 1
DecodeType = "acExpression"
Case 2
DecodeType = "acFieldHasFocus"
Case 3
DecodeType = "acDataBar"
End Select
End Function
Function DecodeOp(OpProp As Integer) As String
' You need this becuase equations can comprise of = > <> between
' https://vb123.com/listing-conditional-formats
Select Case OpProp
Case 0
DecodeOp = "acBetween"
Case 1
DecodeOp = "acNotBetween"
Case 2
DecodeOp = "acEqual"
Case 3
DecodeOp = "acNotEqual"
Case 4
DecodeOp = "acGreaterThan"
Case 5
DecodeOp = "acLessThan"
Case 6
DecodeOp = "acGreaterThanOrEqual"
Case 7
DecodeOp = "acLessThanOrEqual"
End Select
End Function
I couldn't find anything specific to this so here goes.
I have a For Each loop where I want to write values to a csv file. Currently, I use a WriteToFile function:
Public Sub WriteToFile(stuff as string, morestuff as string, moremorestuff as string))
Dim strFile As String = "\\SomeServer\somefilepath\WriteTo.csv"
Try
If System.IO.File.Exists(strFile) = True Then
'rename with startdate and enddate. Always want to create new
Dim objWriter As New System.IO.StreamWriter(strFile, True)
objWriter.WriteLine(Stuff & "," & MoreStuff & "," & Moremorestuff)
objWriter.Close()
Else
Dim writeFile As IO.StreamWriter
writeFile = IO.File.CreateText(strFile)
writeFile.WriteLine("Stuff" & "," & "MoreStuff" & "," & "MoreMoreStuff")
writeFile.WriteLine(Stuff & "," & MoreStuff & "," & MoreMoreStuff)
writeFile.Close()
End If
Catch ex As Exception
MessageBox.Show("An error has occured in the WriteToFile subroutine: " & ex.ToString) ' & vbCrLf & strPlugin & vbCrLf & strVersion)
End Try
End Sub
Rather than closing the StreamWriter after every record is written, is there a way to keep it open? Or should it be kept open?
I made some changes and came up with this. However, using this code, how would I create a header in the csv file?
If cur.Count > 0 Then
Using writer As System.IO.StreamWriter = New IO.StreamWriter("C:\Temp\UWConditions.csv")
For Each lrdata As LoanReportData In cur
loan = session.Loans.Open(lrdata.Guid)
If Not IsNothing(loan) Then
For Each condition As UnderwritingCondition In loan.Log.UnderwritingConditions
Title = condition.Title.Replace(",", "")
Desc = condition.Description.Replace(",", "")
UWName = loan.Session.Users.GetUser(loan.Fields("UWID").Value).FullName.Replace(",", "")
writer.WriteLine(lrdata("Loan.LoanNumber") & "," & Title & "," & Desc & "," & UWName)
Next
loan.Close()
End If
Next
End Using
End If
I have the following code to check windows updates
Function CheckWinUpdates() As Integer
CheckWinUpdates = 0
Dim WUSession As UpdateSession
Dim WUSearcher As UpdateSearcher
Dim WUSearchResults As ISearchResult
Try
WUSession = New UpdateSession
WUSearcher = WUSession.CreateUpdateSearcher()
WUSearchResults = WUSearcher.Search("IsInstalled=0 and Type='Software'")
CheckWinUpdates = WUSearchResults.Updates.Count
Catch ex As Exception
CheckWinUpdates = -1
End Try
If CheckWinUpdates > 0 Then
Try
'Dim Update As IUpdate
Dim i As Integer = 0
For i = 0 To WUSearchResults.Updates.Count - 1
'Update = WUSearchResults.Updates.Item(i)
EventLog.WriteEntry("Item is type: " & WUSearchResults.Updates.Item(i).ToString, EventLogEntryType.Information, 85)
EventLog.WriteEntry("Deadline: " & WUSearchResults.Updates.Item(i).Deadline.ToString, EventLogEntryType.Information, 85)
EventLog.WriteEntry("Type: " & WUSearchResults.Updates.Item(i).Type.ToString, EventLogEntryType.Information, 85)
EventLog.WriteEntry("Released on: " & WUSearchResults.Updates.Item(i).LastDeploymentChangeTime, EventLogEntryType.Information, 85)
EventLog.WriteEntry("This windows update is required: " & WUSearchResults.Updates.Item(i).Title, EventLogEntryType.Information, 85)
'EventLog.WriteEntry("This windows update is required: " & Update.Title & vbCrLf & "Released on: " &
' Update.LastDeploymentChangeTime & vbCrLf & "Type: " & Update.Type.ToString & vbCrLf &
' "Deadline: " & Update.Deadline.ToString & vbCrLf & vbCrLf & "Item is type: " & Update.ToString, EventLogEntryType.Information, 85)
Next
Catch ex As Exception
EventLog.WriteEntry("Error while attempting to log required updates:" & vbCrLf & ex.Message, EventLogEntryType.Error, 86)
End Try
End If
WUSearchResults = Nothing
WUSearcher = Nothing
WUSession = Nothing
End Function
My intention with this is to a) get the number of windows updates that are applicable, and b) to look at what other properties are available, and more specifically see how many are older than a week or 2.
I know that UpdateSearcher doesn't allow to search by date, so I am looking to iterate through each item and then later report on each one.
At the moment my function does quite happily return the number of updtes, but when I try to get any of the properties I get "Object reference not set to an instance of an object".
Any ideas where I'm going wrong?
I got this working, turns it it doesn't like the deadline property, I don't know it comes up with "object reference not set", but for what I need it doesn't matter.
I am having an issue changing runtime generated checkbox names in runtime generated groupboxes. I am using multiple groupboxes, and then taking all of the rows in a database and creating checkboxes for them. The checkbox names are as follows ""chkClass" & intGroupBoxNumber & intCurrentRow". Upon deletion of a groupbox, I renumber all of the current group boxes, and would like the checkbox names to change as well to the new groupbox number, if this makes any sense. My code is as follows:
strControlName = "grpGroup" & strIBResult
Try
intGroupBoxOldYLocation = Me.Controls(strControlName).Location
Me.Controls(strControlName).Dispose()
MessageBox.Show("Deleted: " & strControlName)
intRenameGroup = strIBResult + 1
Try
strControlName = "grpGroup" & intRenameGroup
strControlNewName = "grpGroup" & intRenameGroup - 1
Me.Controls(strControlName).Location = intGroupBoxOldYLocation
Me.Controls(strControlName).Text = "Group " & intRenameGroup - 1
Me.Controls(strControlName).Name = strControlNewName
MessageBox.Show("Changed: " & strControlName & " to: " & strControlNewName)
Do While intCurrentClassRow < intTotalClassRows
strCheckBoxOldName = "chkClass" & intRenameGroup & intCurrentClassRow
strCheckBoxNewName = "chkClass" & intRenameGroup - 1 & intCurrentClassRow
MessageBox.Show("Renaming: " & strCheckBoxOldName & " to: " & strCheckBoxNewName)
Me.Controls(strCheckBoxOldName).Name = strCheckBoxNewName
intCurrentClassRow += 1
MessageBox.Show("Renamed: " & strCheckBoxOldName & " to: " & strCheckBoxNewName)
Loop
intCurrentClassRow = 0
intRenameGroup += 1
intGroupBoxNewYIncrement = intGroupBoxOldYLocation.Y + Me.Controls(strControlNewName).Height + 50
Do
strControlName = "grpGroup" & intRenameGroup
strControlNewName = "grpGroup" & intRenameGroup - 1
Me.Controls(strControlName).Location = New Point(intCurrentXPosition, intGroupBoxNewYIncrement)
Me.Controls(strControlName).Text = "Group " & intRenameGroup - 1
Me.Controls(strControlName).Name = strControlNewName
Do While intCurrentClassRow < intTotalClassRows
strCheckBoxOldName = "chkClass" & intRenameGroup & intCurrentClassRow
strCheckBoxNewName = "chkClass" & intRenameGroup - 1 & intCurrentClassRow
Me.Controls(strCheckBoxOldName).Name = strCheckBoxNewName
intCurrentClassRow += 1
MessageBox.Show("Renamed: " & strCheckBoxOldName & " to: " & strCheckBoxNewName)
Loop
intCurrentClassRow = 0
intRenameGroup += 1
intGroupBoxNewYIncrement = intGroupBoxNewYIncrement + Me.Controls(strControlNewName).Height + 50
Loop
Catch ex As Exception
MessageBox.Show("Control: " & strControlName & " does not exist")
MessageBox.Show(ErrorToString)
End Try
Catch ex As Exception
'MessageBox.Show("Control: " & strControlName & " never existed")
MessageBox.Show("Please enter a valid group number to delete.", "Invalid Entry")
Exit Sub
End Try
I am pretty sure my trouble now exists at the Me.Controls(strCheckBoxOldName).Name = strCheckBoxNewName
The error is as follows: "Object reference not set to an instance of an object"
Is there a different method to reference that runtime generated groupbox?
Thanks. Sorry if this is confusing!
The form's Controls collection only contains the top-level controls that are placed directly on the form. If you load a control into a container control, such as a GroupBox, you must find it in that container control's Controls collection.
So, instead of doing this:
Me.Controls(strCheckBoxOldName).Name = strCheckBoxNewName
You should be doing something like this:
Me.Controls(strControlName).Controls(strCheckBoxOldName).Name = strCheckBoxNewName
I would temporarily comment out the try/catch blocks. Then the application will break at the offending statement and you won't have to be just "pretty sure" where the problem is. Then, check the values of the associated variables (highlight, shfit-F9). You'll probably find that one of the objects has a value of nothing. This causes the error message you mentioned.