This topic is related to Loop through links and download PDF's
I am trying to convert my current VBA code into VBScript. I have already understood that I have to remove the variable types (As ... part of Dim statements) and use CreatObject to get those objects but otherwise everything should port as-is. DoEvents will also have to be replaced with something like Wscript.sleep.
I came up with some problems. Currently while running VBS file I am getting an error saying "Object required: 'MSHTML'". Pointing to line 65, where I have Set hDoc = MSHTML.HTMLDocument. I have tried to search on Google but got nothing helpful for this one.
How I should proceed with this one?
DownloadFiles("https://www.nordicwater.com/products/waste-water/")
Sub DownloadFiles(p_sURL)
Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim xHttp
Dim hDoc
Dim Anchors
Dim Anchor
Dim sPath
Dim wholeURL
Dim internet
Dim internetdata
Dim internetlink
Dim internetinnerlink
Dim arrLinks
Dim sLink
Dim iLinkCount
Dim iCounter
Dim sLinks
Set internet = CreateObject("InternetExplorer.Application")
internet.Visible = False
internet.navigate (p_sURL)
Do Until internet.ReadyState = 4
Wscript.Sleep 100
Loop
Set internetdata = internet.document
Set internetlink = internetdata.getElementsByTagName("a")
i = 1
For Each internetinnerlink In internetlink
If Left(internetinnerlink, 36) = "https://www.nordicwater.com/product/" Then
If sLinks <> "" Then sLinks = sLinks & vbCrLf
sLinks = sLinks & internetinnerlink.href
i = i + 1
Else
End If
Next
wholeURL = "https://www.nordicwater.com/"
sPath = "C:\temp\"
arrLinks = Split(sLinks, vbCrLf)
iLinkCount = UBound(arrLinks) + 1
For iCounter = 1 To iLinkCount
sLink = arrLinks(iCounter - 1)
'Get the directory listing
xHttp.Open "GET", sLink
xHttp.send
'Wait for the page to load
Do Until xHttp.ReadyState = 4
Wscript.Sleep 100
Loop
'Put the page in an HTML document
Set hDoc = MSHTML.HTMLDocument
hDoc.body.innerHTML = xHttp.responseText
'Loop through the hyperlinks on the directory listing
Set Anchors = hDoc.getElementsByTagName("a")
For Each Anchor In Anchors
'test the pathname to see if it matches your pattern
If Anchor.pathname Like "*.pdf" Then
xHttp.Open "GET", wholeURL & Anchor.pathname, False
xHttp.send
With CreateObject("Adodb.Stream")
.Type = 1
.Open
.write xHttp.responseBody
.SaveToFile sPath & getName(wholeURL & Anchor.pathname), 2 '//overwrite
End With
End If
Next
Next
End Sub
Function:
Function getName(pf)
getName = Split(pf, "/")(UBound(Split(pf, "/")))
End Function
Instead of Set hDoc = MSHTML.HTMLDocument, use:
Set hDoc = CreateObject("htmlfile")
In VBA/VB6 you can specify variable and object types but not with VBScript. You have to use CreateObject (or GetObject: GetObject function) to instantiate objects like MSHTML.HTMLDocument, Microsoft.XMLHTTP, InternetExplorer.Application, etc instead of declaring those using Dim objIE As InternetExplorer.Application for example.
Another change:
If Anchor.pathname Like "*.pdf" Then
can be written using StrComp function:
If StrComp(Right(Anchor.pathname, 4), ".pdf", vbTextCompare) = 0 Then
or using InStr function:
If InStr(Anchor.pathname, ".pdf") > 0 Then
Also, at the beginning of your sub, you do the following:
Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim xHttp
You should declare your variables before assigning them values or objects. In VBScript this is very relaxed, your code will work because VBScript will create undefined variables for you but it's good practice to Dim your variables before using them.
Except for Wscript.sleep commands, your VBScript code will work in VB6/VBA so you can debug your script in VB6 or VBA apps (like Excel).
Dim EAM017 As EAM017_LNG_SI_GetDetails_Out_SyncService.SI_GetDetails_Out_SyncSoapClient
If URL.Contains("http") Then
Dim endPointHttp = New System.ServiceModel.EndpointAddress(URL)
binding.Security.Mode = System.ServiceModel.BasicHttpSecurityMode.TransportCredentialOnly
binding.Security.Transport.ClientCredentialType = System.ServiceModel.HttpClientCredentialType.Basic
EAM017 = New EAM017_LNG_SI_GetDetails_Out_SyncService.SI_GetDetails_Out_SyncSoapClient(binding, endPointHttp)
EAM017.ClientCredentials.UserName.UserName = UserName
EAM017.ClientCredentials.UserName.Password = Password
End If
EAM017.FunctionalLocation(MyMTFuncLocRequest)
Now error is EAM017 has been used before a value is assigned.
The solution is to put it inside the if block but I don't want to do that and should be outside becuase more code is going to be there in future in the same way.
What should I do?
Consider the following
' EAM017 is declared, but not assigned to anything, thus is Nothing / null
Dim EAM017 As EAM017_LNG_SI_GetDetails_Out_SyncService.SI_GetDetails_Out_SyncSoapClient
' your URL doesn't contain http
URL = "ftp://123.456.789.001"
' this condition is false ...
If URL.Contains("http") Then
' ... so this line doesn't happen
EAM017 = New EAM017_LNG_SI_GetDetails_Out_SyncService.SI_GetDetails_Out_SyncSoapClient(binding, endPointHttp)
End If
' EAM017 was never assigned, and is null. A null object exception will happen at runtime
EAM017.FunctionalLocation(MyMTFuncLocRequest)
Now you might say that your URL will always contain "http", then you don't need the If.
But if it's possible it won't contain "http" then you shouldn't be doing anything with a null object. You should either
Add another case (where URL contains "ftp" for example) and assign the object in there accordingly
Move the line EAM017.FunctionalLocation(MyMTFuncLocRequest) inside the If
Move the line EAM017 = New EAM017_LNG_SI_GetDetails_Out_SyncService.SI_GetDetails_Out_SyncSoapClient(binding, endPointHttp) outside the If
You can add a Not to the if statement and exit the sub if the requirements are not met. If they are met then just continue with the rest of he code.
To answer your question in the title. Not all code paths include the initialization of EAM017.
Private Sub OPCode(URL As String)
Dim EAM017 As EAM017_LNG_SI_GetDetails_Out_SyncService.SI_GetDetails_Out_SyncSoapClient
If Not URL.Contains("http") Then
'Notify the user and exit the sub
Return
End If
Dim endPointHttp = New System.ServiceModel.EndpointAddress(URL)
Binding.Security.Mode = System.ServiceModel.BasicHttpSecurityMode.TransportCredentialOnly
Binding.Security.Transport.ClientCredentialType = System.ServiceModel.HttpClientCredentialType.Basic
EAM017 = New EAM017_LNG_SI_GetDetails_Out_SyncService.SI_GetDetails_Out_SyncSoapClient(Binding, endPointHttp)
EAM017.ClientCredentials.UserName.UserName = UserName
EAM017.ClientCredentials.UserName.Password = Password
EAM017.FunctionalLocation(MyMTFuncLocRequest)
End Sub
I have an executable that I call using the shell command:
Shell (ThisWorkbook.Path & "\ProcessData.exe")
The executable does some computations, then exports results back to Excel. I want to be able to change the format of the results AFTER they are exported.
In other words, i need the Shell command first to WAIT until the executable finishes its task, exports the data, and THEN do the next commands to format.
I tried the Shellandwait(), but without much luck.
I had:
Sub Test()
ShellandWait (ThisWorkbook.Path & "\ProcessData.exe")
'Additional lines to format cells as needed
End Sub
Unfortunately, still, formatting takes place first before the executable finishes.
Just for reference, here was my full code using ShellandWait
' Start the indicated program and wait for it
' to finish, hiding while we wait.
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Const INFINITE = &HFFFF
Private Sub ShellAndWait(ByVal program_name As String)
Dim process_id As Long
Dim process_handle As Long
' Start the program.
On Error GoTo ShellError
process_id = Shell(program_name)
On Error GoTo 0
' Wait for the program to finish.
' Get the process handle.
process_handle = OpenProcess(SYNCHRONIZE, 0, process_id)
If process_handle <> 0 Then
WaitForSingleObject process_handle, INFINITE
CloseHandle process_handle
End If
Exit Sub
ShellError:
MsgBox "Error starting task " & _
txtProgram.Text & vbCrLf & _
Err.Description, vbOKOnly Or vbExclamation, _
"Error"
End Sub
Sub ProcessData()
ShellAndWait (ThisWorkbook.Path & "\Datacleanup.exe")
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
End Sub
Try the WshShell object instead of the native Shell function.
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
Dim errorCode As Long
errorCode = wsh.Run("notepad.exe", windowStyle, waitOnReturn)
If errorCode = 0 Then
MsgBox "Done! No error to report."
Else
MsgBox "Program exited with error code " & errorCode & "."
End If
Though note that:
If bWaitOnReturn is set to false (the default), the Run method returns immediately after starting the program, automatically returning 0 (not to be interpreted as an error code).
So to detect whether the program executed successfully, you need waitOnReturn to be set to True as in my example above. Otherwise it will just return zero no matter what.
For early binding (gives access to Autocompletion), set a reference to "Windows Script Host Object Model" (Tools > Reference > set checkmark) and declare like this:
Dim wsh As WshShell
Set wsh = New WshShell
Now to run your process instead of Notepad... I expect your system will balk at paths containing space characters (...\My Documents\..., ...\Program Files\..., etc.), so you should enclose the path in "quotes":
Dim pth as String
pth = """" & ThisWorkbook.Path & "\ProcessData.exe" & """"
errorCode = wsh.Run(pth , windowStyle, waitOnReturn)
What you have will work once you add
Private Const SYNCHRONIZE = &H100000
which your missing. (Meaning 0 is being passed as the access right to OpenProcess which is not valid)
Making Option Explicit the top line of all your modules would have raised an error in this case
Shell-and-Wait in VBA (Compact Edition)
Sub ShellAndWait(pathFile As String)
With CreateObject("WScript.Shell")
.Run pathFile, 1, True
End With
End Sub
Example Usage:
Sub demo_Wait()
ShellAndWait ("notepad.exe")
Beep 'this won't run until Notepad window is closed
MsgBox "Done!"
End Sub
Adapted from (and more options at) Chip Pearson's site.
The WScript.Shell object's .Run() method as demonstrated in Jean-François Corbett's helpful answer is the right choice if you know that the command you invoke will finish in the expected time frame.
Below is SyncShell(), an alternative that allows you to specify a timeout, inspired by the great ShellAndWait() implementation. (The latter is a bit heavy-handed and sometimes a leaner alternative is preferable.)
' Windows API function declarations.
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByRef lpExitCodeOut As Long) As Integer
' Synchronously executes the specified command and returns its exit code.
' Waits indefinitely for the command to finish, unless you pass a
' timeout value in seconds for `timeoutInSecs`.
Private Function SyncShell(ByVal cmd As String, _
Optional ByVal windowStyle As VbAppWinStyle = vbMinimizedFocus, _
Optional ByVal timeoutInSecs As Double = -1) As Long
Dim pid As Long ' PID (process ID) as returned by Shell().
Dim h As Long ' Process handle
Dim sts As Long ' WinAPI return value
Dim timeoutMs As Long ' WINAPI timeout value
Dim exitCode As Long
' Invoke the command (invariably asynchronously) and store the PID returned.
' Note that this invocation may raise an error.
pid = Shell(cmd, windowStyle)
' Translate the PIP into a process *handle* with the
' SYNCHRONIZE and PROCESS_QUERY_LIMITED_INFORMATION access rights,
' so we can wait for the process to terminate and query its exit code.
' &H100000 == SYNCHRONIZE, &H1000 == PROCESS_QUERY_LIMITED_INFORMATION
h = OpenProcess(&H100000 Or &H1000, 0, pid)
If h = 0 Then
Err.Raise vbObjectError + 1024, , _
"Failed to obtain process handle for process with ID " & pid & "."
End If
' Now wait for the process to terminate.
If timeoutInSecs = -1 Then
timeoutMs = &HFFFF ' INFINITE
Else
timeoutMs = timeoutInSecs * 1000
End If
sts = WaitForSingleObject(h, timeoutMs)
If sts <> 0 Then
Err.Raise vbObjectError + 1025, , _
"Waiting for process with ID " & pid & _
" to terminate timed out, or an unexpected error occurred."
End If
' Obtain the process's exit code.
sts = GetExitCodeProcess(h, exitCode) ' Return value is a BOOL: 1 for true, 0 for false
If sts <> 1 Then
Err.Raise vbObjectError + 1026, , _
"Failed to obtain exit code for process ID " & pid & "."
End If
CloseHandle h
' Return the exit code.
SyncShell = exitCode
End Function
' Example
Sub Main()
Dim cmd As String
Dim exitCode As Long
cmd = "Notepad"
' Synchronously invoke the command and wait
' at most 5 seconds for it to terminate.
exitCode = SyncShell(cmd, vbNormalFocus, 5)
MsgBox "'" & cmd & "' finished with exit code " & exitCode & ".", vbInformation
End Sub
Simpler and Compressed Code with examples:
first declare your path
Dim path: path = ThisWorkbook.Path & "\ProcessData.exe"
And then use any one line of following code you like
1) Shown + waited + exited
VBA.CreateObject("WScript.Shell").Run path,1, True
2) Hidden + waited + exited
VBA.CreateObject("WScript.Shell").Run path,0, True
3) Shown + No waited
VBA.CreateObject("WScript.Shell").Run path,1, False
4) Hidden + No waited
VBA.CreateObject("WScript.Shell").Run path,0, False
I was looking for a simple solution too and finally ended up to make these two functions, so maybe for future enthusiast readers :)
1.) prog must be running, reads tasklist from dos, output status to
file, read file in vba
2.) start prog and wait till prog is closed with a wscript shell .exec waitonrun
3.) ask for confirmation to delete tmp file
Modify program name and path variables and run in one go.
Sub dosWOR_caller()
Dim pwatch As String, ppath As String, pfull As String
pwatch = "vlc.exe" 'process to watch, or process.exe (do NOT use on cmd.exe itself...)
ppath = "C:\Program Files\VideoLAN\VLC" 'path to the program, or ThisWorkbook.Path
pfull = ppath & "\" & pwatch 'extra quotes in cmd line
Dim fout As String 'tmp file for r/w status in 1)
fout = Environ("userprofile") & "\Desktop\dosWaitOnRun_log.txt"
Dim status As Boolean, t As Double
status = False
'1) wait until done
t = Timer
If Not status Then Debug.Print "run prog first for this one! then close it to stop dosWORrun ": Shell (pfull)
status = dosWORrun(pwatch, fout)
If status Then Debug.Print "elapsed time: "; Format(Timer - t, "#.00s")
'2) wait while running
t = Timer
Debug.Print "now running the prog and waiting you close it..."
status = dosWORexec(pfull)
If status = True Then Debug.Print "elapsed time: "; Format(Timer - t, "#.00s")
'3) or if you need user action
With CreateObject("wScript.Shell")
.Run "cmd.exe /c title=.:The end:. & set /p""=Just press [enter] to delete tmp file"" & del " & fout & " & set/p""=and again to quit ;)""", 1, True
End With
End Sub
Function dosWORrun(pwatch As String, fout As String) As Boolean
'redirect sdtout to file, then read status and loop
Dim i As Long, scatch() As String
dosWORrun = False
If pwatch = "cmd.exe" Then Exit Function
With CreateObject("wScript.Shell")
Do
i = i + 1
.Run "cmd /c >""" & fout & """ (tasklist |find """ & pwatch & """ >nul && echo.""still running""|| echo.""done"")", 0, True
scatch = fReadb(fout)
Debug.Print i; scatch(0)
Loop Until scatch(0) = """done"""
End With
dosWORrun = True
End Function
Function dosWORexec(pwatch As String) As Boolean
'the trick: with .exec method, use .stdout.readall of the WshlExec object to force vba to wait too!
Dim scatch() As String, y As Object
dosWORexec = False
With CreateObject("wScript.Shell")
Set y = .exec("cmd.exe /k """ & pwatch & """ & exit")
scatch = Split(y.stdout.readall, vbNewLine)
Debug.Print y.status
Set y = Nothing
End With
dosWORexec = True
End Function
Function fReadb(txtfile As String) As String()
'fast read
Dim ff As Long, data As String
'~~. Open as txt File and read it in one go into memory
ff = FreeFile
Open txtfile For Binary As #ff
data = Space$(LOF(1))
Get #ff, , data
Close #ff
'~~> Store content in array
fReadb = Split(data, vbCrLf)
'~~ skip last crlf
If UBound(fReadb) <> -1 Then ReDim Preserve fReadb(0 To UBound(fReadb) - 1)
End Function
I incorporated this into a routine, and it has worked fine (but not used very often) for several years - for which, many thanks !
But now I find it throws up an error :-
Run-time error '-2147024894 (80070002)':
Method 'Run' of object 'IWshSheB' failed
on the line -
ErrorCode = wsh.Run(myCommand, windowStyle, WaitOnReturn)
Very strange !
5 hours later !
I THINK the reason it fails is that dear MicroSoft ("dear" meaning expensive) has changed something radical - "Shell" USED to be "Shell to DOS", but has that been changed >=?
The "Command" that I want the Shell to run is simply DIR
In full, it is "DIR C:\Folder\ /S >myFIle.txt"
. . . . . . . . . . . . . . . . . . . . . .
An hour after that-
Yup !
I have "solved" it by using this Code, which works just fine :-
Sub ShellAndWait(PathFile As String, _
Optional Wait As Boolean = True, _
Optional Hidden As Boolean = True)
' Hidden = 0; Shown = 1
Dim Hash As Integer, myBat As String, Shown As Integer
Shown = 0
If Hidden Then Shown = 1
If Hidden <> 0 Then Hidden = 1
Hash = FreeFile
myBat = "C:\Users\Public\myBat.bat"
Open myBat For Output As #Hash
Print #Hash, PathFile
Close #Hash
With CreateObject("WScript.Shell")
.Run myBat, Shown, Wait
End With
End Sub
I would come at this by using the Timer function. Figure out roughly how long you'd like the macro to pause while the .exe does its thing, and then change the '10' in the commented line to whatever time (in seconds) that you'd like.
Strt = Timer
Shell (ThisWorkbook.Path & "\ProcessData.exe")
Do While Timer < Strt + 10 'This line loops the code for 10 seconds
Loop
UserForm2.Hide
'Additional lines to set formatting
This should do the trick, let me know if not.
Cheers, Ben.
On a few of the Classic ASP websites I manage for the last few days I have been getting some error notifications (with no error number) that always show an error on a line number where a cookie value is being requested.
Looking at the request for each of these errors, they all have unusual cookies, and look like some sort of hack attempt.
The lines that are indicated as causing the error are all like this:
strCookieCart = Request.Cookies("cart")
Here's a couple of samples of the cookies being sent (truncated)... Note the =true (no name, just a value).
HTTP_COOKIE:=true; yuv=u97Yoe-o0UWp7ho_vaB2csT-xxaQ37gMWzhB1MARTSNk1QKpjJTXmZYMRQ095rM96MaNbhx1tEdJ
HTTP_COOKIE:pll_language=en; =true; yandexuid=6536735381437958890; st=6c9838994ffb
Is Classic ASP incapable of handling these? Is there any way to avoid these errors and ignore the bad values? Are these always likely to be hack attempts or could there be legitimate requests without cookie names?
I suppose I could check for these looking at Request.ServerVariables("HTTP_COOKIE") by manually parsing or using a regular expression check of some sort. Does anyone else do this? Any code to share?
A second answer to my own question and the solution I have now implemented is to add the following code to my common include file.
It tests whether Classic ASP can read the cookies and, using error trapping, ends the response if an error is detected.
On Error Resume Next
Request.Cookies("test")
If Err.Number <> 0 Then Response.End
On Error Goto 0
This is a better solution to my other answer as there is no point in generating a page for what is obviously an attack of some sort so ending the script as soon as possible is a better choice.
My proposed answer to my own question is to create a class that extracts all the valid keys and values for the cookies on initialisation, and has a function to return a value for a specified key.
Unfortunately it doesn't work for cookies that contain a collection of multiple values, but I don't generally use these anyway.
Here is the class:
<%
Class MyRequest
Private m_objCookies
Private Sub Class_Initialize()
Dim strCookies, i, strChar, strName, strValue, blnInValue
strCookies = Request.ServerVariables("HTTP_COOKIE")
Set m_objCookies = Server.CreateObject("Scripting.Dictionary")
i = 1
strName = ""
strValue = ""
blnInValue = False
Do
strChar = Mid(strCookies, i, 1)
If strChar = ";" Or i = Len(strCookies) Then
strValue = Trim(strValue)
If strName <> "" And strValue <> "" Then
If m_objCookies.Exists(strName) Then
m_objCookies.Item(strName) = strValue
Else
m_objCookies.Add strName, strValue
End If
End If
If i = Len(strCookies) Then Exit Do
strName = ""
strValue = ""
blnInValue = False
ElseIf strChar = "=" Then
strName = Trim(strName)
blnInValue = True
ElseIf blnInValue Then
strValue = strValue & strChar
Else
strName = strName & strChar
End If
i = i + 1
Loop
End Sub
Public Function Cookies(strKey)
Cookies = m_objCookies.Item(strKey)
End Function
End Class
%>
The changes to my code to use this class are minimal. Where I currently have...
strCookieCart = Request.Cookies("cart")
I will need to change to...
Dim objMyRequest : Set objMyRequest = New MyRequest
strCookieCart = objMyRequest.Cookies("cart")
I have tested the above with many of the bad requests I have logged and it works fine.
Add three line codes for #johna is answer, after this line:
If strChar = ";" Or i = Len(strCookies) Then
add these lines:
If i = Len(strCookies) And strChar <> ";" Then
strValue = strValue & strChar
End If
I'm relatively new to functions and classes so not too sure if this is a beginners mistake. I'm getting:
Microsoft VBScript runtime error '800a01a8'
Object required: 'EngineerNote(...)'
/backup-check/backup_frontendlist_import_NEW.asp, line 76
Line 76 is:
Set NoteArray=EngineerNote(company, servername, backupsolution)
The three variables I'm passing are all strings. All the function and class is set in:
Class EngineerNoteClass
public note
public notesubmitdate
End Class
Function EngineerNote(Company, ServerName, Solution)
Set RecordSet = Server.CreateObject("ADODB.Recordset")
RecordSetSQLString = "SELECT note, submitdate FROM tbl_BackupChecks_AuditInformation WHERE Company='" & company & "' AND ServerName='" & servername & "' AND Solution='" & solution & "' ORDER BY submitdate desc;"
RecordSet.Open RecordSetSQLString, DatabaseConnection
If Recordset.EOF Then
'Do Nothing
Else
Dim NoteResults
Set NoteResults = new EngineerNoteClass
noteresults.note = RecordSet("note")
noteresults.notesubmitdate = RecordSet("submitdate")
Set Engineernote = NoteResults
End If
Recordset.Close
End Function
Most likely your database query didn't return any results. You only set the return value of your function when the recordset isn't at EOF:
If Recordset.EOF Then
'Do Nothing
Else
...
Set Engineernote = NoteResults
End If
Setting the return value to Nothing (or to an empty EngineerNoteClass object) in the Then branch should make the error go away:
If Recordset.EOF Then
Set EngineerNote = Nothing
Else
...
Set Engineernote = NoteResults
End If
Make sure you handle the returned value/object appropriately in the rest of your script.