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.
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 ]
I have tried this every different way, and it was working yesterday, so I really don't know what changed.
I import a spreadsheet to a temp table in an Access app. Then I set that to be the dao.recordset, and start looping through. I check for the ID to not be null and if not go through checking fields for values, and updating as appropriate. the minute I hit a null, I get a system error "94 - invalid use of null"
It doesn't offer a debug, but I have debugs throughout my code, so I can see where it fails. It fails when I do this check: If IsNull(rstImportCList("columnx")) = False Then
I have tried nz(rstImportCList("columnx"),"") <> "" I have tried rstImportCList("columnx") is not null, and everything else I can think of. Why is the check that is supposed to prevent this error, causing this error?
Edit:
This is the beginning where I declare the recordset I can't get past doing anything with the recordset field.
Dim db As DAO.Database
Dim rstImportCList As DAO.Recordset
Dim RSsql As String
Set db = CurrentDb()
RSsql = "Select * from tblTempImportCList"
Set rstImportCList = db.OpenRecordset(RSsql)
If rstImportCList.EOF Then Exit Sub
Do While Not rstImportCList.EOF
whether I try to check
IsNull(rstImportCList("xyz").Value) = False
or
nz(rstImportCList("xyz").Value,"") <> ""
or
dim x as string
x = rstImportCList!xyz.value
I get the same error 94 invalid use of null.
Any idea why this is?
--edit with more code.
I took some time to take a the beginning and some of each section of the code, so I could make it generic and see if anyone can help. Here is what I am working on. The Code1 and Code2 parts don't seem to be the issue. Sometimes it fails on a null value in a Yes/No column (I'm just looking for Y but the value is null), sometimes on the notes being null. It's not consistent, which is why I'm having a hard time nailing down the issue.
Private Sub cmdImportList_Click()
On Error GoTo cmdImportExcel_Click_err:
Dim fdObj As FileDialog
Set fdObj = Application.FileDialog(msoFileDialogFilePicker)
Dim varfile As Variant
Dim importCT As Integer
Dim dbu As DAO.Database
Dim cBadXVal, cBadYVal As Integer
Dim preNotes As String
Dim RSsql As String
Dim uNotesql, uVal1sql, uVal2sql As String
Dim db As DAO.Database
Dim rstImportCList As DAO.Recordset
Dim CheckB4Import As Integer
CheckB4Import = MsgBox("Are you SURE the sheet you are importing has the following column names in the same order:" & vbCrLf & vbCrLf & _
"IDName/ First/ Mid/ Last/ Sfx/ Age/ Telephone/ Code1/ Code2/ YN1/ YN2/ NY3/ Notes/ AsYN1edTo" & vbCrLf & vbCrLf & _
"AND that there are NO empty rows or empty columns?" & vbCrLf & vbCrLf & _
"Click OK to proceed, Click CANCEL to go double-check your CallSheet before importing.", vbOKCancel, "WITH GREAT POWER COMES GREAT RESPONSIBILITY TO QC DATA")
If CheckB4Import = vbOK Then
CurrentDb.Execute "DELETE * FROM tblTempImportCList", dbFailOnError
With fdObj
'CAN ONLY SELECT 1 FILE
.allowmultiselect = False
.Filters.Clear
.Filters.Add "Excel 2007+", "*.xlsx"
.Title = "Please select the completed list to import:"
.Show
If .SelectedItems.Count = 1 Then
varfile = .SelectedItems(1)
DoCmd.TransferSpreadsheet acImport, , "tblTempImportCList", varfile, True, "Sheet1!"
cBadXVal = DLookup("BadXCount", "qryImpCheckBadXVal")
Debug.Print "cBadXVal - " & cBadXVal
If cBadXVal <> 0 Then
DoCmd.OpenForm "frmImportError", acNormal
Forms!frmImportError.Form.lblErrorMsg.Caption = _
"Oh No! Your list import failed!" & vbCrLf & _
cBadXVal & " X values are not valid." & vbCrLf & _
"Don't worry. You can fix your sheet and re-import!" & vbCrLf & _
"Would you like to open the documentation for the valid codes" & vbCrLf & _
"Or are you all set?"
End If
cBadYVal = DLookup("BadYCount", "qryImpCheckBadYVal")
Debug.Print "cBadYVal - " & cBadYVal
If cBadYVal <> 0 Then
DoCmd.OpenForm "frmImportError", acNormal
Forms!frmImportError.Form.lblErrorMsg.Caption = _
"Oh No! Your list import failed!" & vbCrLf & _
cBadYVal & " YN1 values are not valid." & vbCrLf & _
"Don't worry. You can fix your sheet and re-import!" & vbCrLf & _
"Would you like to open the documentation for the valid codes" & vbCrLf & _
"Or are you all set?"
Exit Sub
End If
Else
MsgBox "No file was selected. Try again!", vbCritical, "Uh-oh Spaghettios!"
End If
End With
'PASSED CHECKS
Set db = CurrentDb()
RSsql = "Select * from tblTempImportCList"
Set rstImportCList = db.OpenRecordset(RSsql)
If rstImportCList.EOF Then Exit Sub
Debug.Print "got here"
Do While Not rstImportCList.EOF
Debug.Print "Start Processing: " & Nz(rstImportCList("IDName").Value, "")
'GET NOTES ALREADY ON RECORD
If Nz(rstImportCList("IDName").Value, "") <> "" Then
Debug.Print "got past if IDName is not null"
If Nz(rstImportCList("Notes").Value, "") <> "" Then
Debug.Print "got past if notes is not null"
preNotes = Replace(Nz(DLookup("Notes", "tblVFileImport", "IDName = " & rstImportCList("IDName").Value), ""), """", "")
'UPDATE NOTES
If Nz(preNotes, "") <> "" Then
uNotesql = "Update tblVFileImport SET tblVFileImport.Notes = '" & preNotes & "; " & Replace(Nz(rstImportCList("Notes").Value, ""), """", "") & "' " & _
"WHERE tblVFileImport.IDName = " & rstImportCList("IDName").Value
'debug.print "Notes"
'debug.print "uNotesql - " & uNotesql
Else
uNotesql = "Update tblVFileImport SET tblVFileImport.Notes = '" & Replace(Nz(rstImportCList("Notes").Value, ""), """", "") & "' " & _
"WHERE tblVFileImport.IDName = " & rstImportCList("IDName").Value
End If
RunMySql (uNotesql)
'DoCmd.RunSQL (uNotesql), dbFailOnError
End If
If Nz(rstImportCList("YN1").Value, "") = "Y" Then
'UPDATE YN1
uYN1sql = "Update tblVFileImport SET tblVFileImport.YN1 = '" & rstImportCList("YN1") & "', tblVFileImport.callprocessed = 'Y' " & _
"WHERE tblVFileImport.IDName = " & rstImportCList("IDName")
Debug.Print "YN1 = Y or y"
Debug.Print "uYN1sql - " & uYN1sql
RunMySql (uYN1sql)
'DoCmd.RunSQL (uYN1sql), dbFailOnError
End If
If Nz(rstImportCList("YN2").Value, "") = "Y" Then
'UPDATE YN2
uYN2sql = "Update tblVFileImport SET tblVFileImport.YN2 = '" & rstImportCList("YN2") & "', tblVFileImport.callprocessed = 'Y' " & _
"WHERE tblVFileImport.IDName = " & rstImportCList("IDName")
Debug.Print "YN2 = Y or y"
Debug.Print "uYN2sql - " & uYN2sql
RunMySql (uYN2sql)
'DoCmd.RunSQL (uYN2sql), dbFailOnError
End If
'START Code1 PROCESSING
If Nz(rstImportCList("Code1").Value, "") <> "" Then
'Code1 Case abc
vdispo = DLookup("Code1", "tblvFileImport", "IDName = " & rstImportCList("IDName"))
If rstImportCList("Code1") = "ABC" Then
Debug.Print "Dispo Case ABC"
'DELETE RECORD
dMDsql = "DELETE from tblVFileImport " & _
"WHERE tblVFileImport.IDName = " & rstImportCList("IDName")
Debug.Print "dMDsql - " & dMDsql
RunMySql (dMDsql)
'DoCmd.RunSQL (dMDsql), dbFailOnError
'Code1 Case DEF OR GHI OR JKL
ElseIf Nz(rstImportCList("Code1"), "") = "DEF" Or Nz(rstImportCList("Code1"), "") = "GHI" Or Nz(rstImportCList("Code1"), "") = "JKL" Then
Debug.Print "Dispo Case DEF OR GHI OR JKL "
'IF DEF
If rstImportCList("Code1") = "DEF" Then
'IF CELL SAME - UPDATE NULL
ccellsame = DLookup("IDName", "tblVFileImport", "IDName = " & rstImportCList("IDName") & " AND nz(Cell,'') = Phone ")
If ccellsame = rstImportCList("IDName") Then
uCellsql = "Update tblVFileImport SET tblVFileImport.Cell = NULL, tblVFileImport.CellString = NULL, tblVFileImport.mobileflag = NULL " & _
"WHERE tblVFileImport.IDName = " & rstImportCList("IDName")
Debug.Print "uCellsql - " & uCellsql
RunMySql (uCellsql)
'DoCmd.RunSQL (uCellsql), dbFailOnError
End If
End If
End If
End If
End If
Debug.Print "End Processing: " & rstImportCList("IDName")
rstImportCList.MoveNext
Loop
Debug.Print "Finished Looping"
rstImportCList.Close
importCT = DCount("IDName", "tblTempImportCList")
MsgBox importCT & " Records imported for list.", vbOKOnly, "List Processed"
Else
MsgBox "Good Call. Check twice, import once!", vbOKOnly, "Better Safe Than Sorry"
End If
Exit Sub
cmdImportExcel_Click_err:
Select Case Err.Number
Case Else
Call MsgBox(Err.Number & " – " & Err.Description, vbCritical + vbOKOnly, "System Error …")
End Select
End Sub
Any suggestions are greatly appreciated. I'm 1/2 tempted to suck this into a SQL table and just execute a stored procedure. I can get it to work in there, I think.
If IsNull(rstImportCList("columnx").Value) Then
otherwise you're checking if the Field object itself is null.
https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/field-object-dao#:~:text=To%20refer%20to,Fields(%22name%22)
This is a case where relying on a default property (in this case Value) causes problems.
I do not understand where "Flag and Err05" (at the bottom of the codes)have been declared ? I have searched the entire project and can not found where the two parameters got declared. When I try to use the below codes in another project , i got the error message "Run time error : items not found in this collection " Any answers?
>Private Sub SanityCheck_Click()
>Dim St As String, WrnFlag As Boolean, j As Integer
>Dim RS As Recordset, RS1 As Recordset, i As Integer, WrongRootCauses As String
>Dim Err01 As String, Err02 As String, Err03 As String, Err04 As String
>WrnFlag = False
>If IsNull(Me.FactoryList) Then
> MsgBox "Select valid Factory before proceeding.", vbExclamation
>Else
> St = "SELECT Factory, Step1, Step2, Step3, Step4, DateColumn FROM [tbl >Factory] WHERE Allowed = True and Factory = """ & Me.FactoryList.Value & """"
> Set RS = CurrentDb.OpenRecordset(St, dbOpenSnapshot)
'-- 12NC codes check --
> St = "SELECT Count([" & RS!Step2 & "].PLANT) AS 12NC_chk " & _
>"FROM [" & RS!Step2 & "] " & _
> "WHERE (((Len(Trim(IIf(Left(Trim([12NC_CODE]),3)=""000"",Right>([12NC_CODE],Len([12NC_CODE])-3),[12NC_CODE])))) Not In (0,1,12)));"
' "WHERE (((Len(Trim([12NC_CODE]))) Not In (0,1,12)));"
> Set RS1 = CurrentDb.OpenRecordset(St, dbOpenSnapshot)
>If RS1.BOF And RS1.EOF Then
> Err05 = "+ No 12NC issues found."
>Else
> RS1.MoveFirst
> RS1.MoveLast
> If RS1![12NC_chk] = 0 Then
> Err05 = "+ No 12NC issues found."
> Else
> Err05 = "- " & RS1![12NC_chk] & " Incorrect 12NCs found!"
> WrnFlag = True
> End If
> End If
'--
> If WrnFlag = True Then **Flag** = vbCritical Else **Flag** = vbInformation
> MsgBox RS!Factory & " input data sanity check:" & vbCrLf & vbCrLf & " " & >Err01 & vbCrLf & " " & Err02 & vbCrLf & " " & Err03 & _
> vbCrLf & " " & Err04 & vbCrLf & " " & Err05 & vbCrLf & vbCrLf & IIf>>(WrongRootCauses = "", "", " Unknown ADP Root Cause(s):" & vbCrLf & WrongRootCauses), Flag
> RS.Close
>RS1.Close
>End If
>End Sub
Two posibilities
Unless the file have Option explicit in the top, you are not forced to explicitely declare variables. Which means that Flag and Err05 have indeed never been declared. VBA will just create them on the fly with a Variant type and an initial value of Nothing.
They might be global variables declared outside of any sub in another file. Try right clicking the variable and then click definition in the menu, Access will show you the way.
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?
I building an ADODB error trap but for some reason, by errSQL.Number and errSQL.Description both give me a "Object variable or With Block variable not set." error....here is my code so far...I have the active x object enabled and I thought that .number and .description are correct...any help would be awesome! The query I'm running also purposely will send an error.
When I comment the error trap out, I do get a message box with a SQL syntax error but can't seem to trap it like below...
Public errSQL As ADODB.Error
Public strErrODBC As String
Private Sub verifySQL()
Dim strSQL2 As String
Dim cn As New ADODB.Connection
Dim cdTxt As String
Dim rs As New ADODB.Recordset
Dim intVerify As Integer
On Error GoTo ODBCErrorHandler
cn.ConnectionString = "DSN=source;"
cn.Open
If cn.State = adStateOpen Then
rs.Open "SELECT CASE WHEN MAX((CASE WHEN " & Forms!dlgSplitName.lstbxFlds.Column(0) & " " & cdTxt & " THEN 1 ELSE 0 END)) =1 THEN 1 ELSE 0 END FROM table;", cn
Else
End If
intVerify = rs.Fields(0).Value
If intVerify = 1 Then
insrt_Test
ElseIf intVerify = 0 Then
MsgBox "No records were found with the code text logic.", vbExclamation + vbOKOnly, "Spliy by Notification"
End If
ODBCErrorHandler:
Debug.Print errSQL.Number
Debug.Print errSQL.Description
strErrODBC = "A SQL error was encountered with the code text logic." & vbCrLf
strErrODBC = strErrODBC & "Error " & errSQL.Number & vbCrLf
strErrODBC = strErrODBC & " " & errSQL.Description
MsgBox strErrODBC & vbCrLf & "Please try again.", vbCritical, "Split by field code text error."
cn.Close
End Sub
The problem is that the errSQL ADODB Error object is never set to anything. the Connection object has an error collection that you need to use to display the errors. Try this:
ODBCErrorHandler:
Dim ErrorCount As Double
Dim strError As String
ErrorCount = cn.Errors.Count
strErrODBC = "A SQL error was encountered with the code text logic." & vbCrLf
If ErrorCount > 0 Then
For index = 0 To (ErrorCount - 1)
Set errSQL = cn.Errors.Item(index)
strErrODBC = strErrODBC & "Error " & errSQL.Number & vbCrLf
strErrODBC = strErrODBC & " " & errSQL.Description & vbCrLf
Next index
End If
MsgBox strErrODBC & vbCrLf & "Please try again.", vbCritical, "Split by field code text error."
cn.Close
Hope this helps.