PDA

View Full Version : Run-Time Error 5



sflash11
06-21-2017, 07:51 AM
I recently inherited an excel document with a VBA code that was getting a run-time error 5. I am very new to VBA, so this was a large task to debug the code. I was able to get it to run through, it previously wasn't doing that, and have made a few changes to the code. I felt I got the corrected but I ran into trouble with the code still not able to run. I will post the code that I have so far as well as attach the original document I received in case I made changes that really didn't help my case.


Sub FAANotice() Dim strTable As String
Dim Datum As String, strDatum As String, strStr As String, strLat As String, strLong As String, strElev As String, strHgt As String, strTraverseway As String, strOnAirport As String
Dim dpos As String, mpos As String, spos As String, dpos1 As String, mpos1 As String, spos1 As String
Dim latDir As String, latD As String, latM As String, latS As String
Dim longDir As String, longD As String, longM As String, longS As String
Dim TW As String
Dim imgURL As String, webpage As String, strResult As String
Dim strDesktop As String, strLocalPath As String, strPath As String
Dim arrWebpage() As String
Dim r As Integer, x As Integer, y As Integer, SavePDF, SaveImg, c As Integer
Dim fldr As FileDialog
Dim LastRow As Long
Dim Prt
Dim CurrentDefaultPrinter As String, DefaultPrinter As String

With Worksheets("StrList")
strTable = .Cells.Find(What:="Structure Number", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Address

c = Range(strTable).Column
r = Range(strTable).Row

LastRow = .Cells(.Rows.Count, c).End(xlUp).Row
End With

Datum = ""
Do Until Datum <> ""
strDatum = InputBox("Type '1' for NAD83 and '2' for NAD27")
Select Case strDatum
Case 1
Datum = "NAD83"
Case 2
Datum = "NAD27"
Case Else
MsgBox "Incorrect 'Datum' selected. Please select NAD83 or NAD27."
Datum = ""
End Select
Loop

'SavePDF = MsgBox("Do you want to save the Results from the FAA website for" & vbCrLf & "each structure?" & vbCrLf & vbCrLf & "NOTE: A SAVE PDF WINDOW WILL OPEN FOR EACH STRUCTURE.", vbYesNo + vbQuestion, "Save PDF Reports")
If SavePDF = vbYes Then
CurrentDefaultPrinter = Application.ActivePrinter
CurrentDefaultPrinter = Left(CurrentDefaultPrinter, InStr(CurrentDefaultPrinter, " on ") - 1)
'MsgBox CurrentDefaultPrinter


Prt = Application.Dialogs(xlDialogPrinterSetup).Show
If Prt = False Then Exit Sub
DefaultPrinter = Application.ActivePrinter
DefaultPrinter = Left(DefaultPrinter, InStr(DefaultPrinter, " on ") - 1)
'MsgBox DefaultPrinter

SetDefaultPrinter (DefaultPrinter)
End If

SaveImg = MsgBox("Do you want to save the map" & vbCrLf & "images from the FAA website" & vbCrLf & "for each structure?", vbYesNo + vbQuestion, "Save Map Images")
If SaveImg = vbYes Then
strDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder to Save Map Images..."
.AllowMultiSelect = False
.InitialFileName = strDesktop
If .Show <> True Then Exit Sub
strLocalPath = .SelectedItems(1)
End With
End If

r = r + 1
Do Until r = LastRow + 1

strStr = Worksheets("StrList").Range("B" & r).Value
strLat = Worksheets("StrList").Range("I" & r).Value
strLong = Worksheets("StrList").Range("H" & r).Value
strElev = Round(Worksheets("StrList").Range("F" & r).Value, 0)
strHgt = Round(Worksheets("StrList").Range("G" & r).Value, 0)
strTraverseway = Worksheets("StrList").Range("J" & r).Value
strOnAirport = Worksheets("StrList").Range("K" & r).Value

'124d15'49.676"W

dpos = InStr(strLat, "d")
mpos = InStr(strLat, "'")
spos = InStr(strLat, Chr(34))
latDir = Right(strLat, 1)
latD = Left(strLat, dpos - 1)
latM = Mid(strLat, dpos + 1, mpos - dpos - 1)
latS = Round(Val(Mid(strLat, mpos + 1, spos - dpos - 1)), 2)

dpos1 = InStr(strLong, "d")
mpos1 = InStr(strLong, "'")
spos1 = InStr(strLong, Chr(34))
longDir = Right(strLong, 1)
longD = Left(strLong, dpos1 - 1)
longM = Mid(strLong, dpos1 + 1, mpos1 - dpos1 - 1)
longS = Round(Val(Mid(strLong, mpos1 + 1, spos1 - mpos1 - 1)), 2)

With CreateObject("InternetExplorer.Application")
.Navigate "https://oeaaa.faa.gov/oeaaa/external/gisTools/gisAction.jsp?action=showNoNoticeRequiredToolForm"
.Visible = True
Do While .busy: DoEvents: Loop
Do While .ReadyState <> 4: DoEvents: Loop

'Latitude
.Document.Forms("dataForm").elements("latD").Value = latD 'Len=2
.Document.Forms("dataForm").elements("latM").Value = latM 'Len=2
.Document.Forms("dataForm").elements("latS").Value = latS 'Len=5
.Document.Forms("dataForm").elements("latDir").Value = latDir 'N/S

'Longitude
.Document.Forms("dataForm").elements("longD").Value = longD 'Len=3
.Document.Forms("dataForm").elements("longM").Value = longM 'Len=2
.Document.Forms("dataForm").elements("longS").Value = longS 'Len=5
.Document.Forms("dataForm").elements("longDir").Value = longDir 'W/E

'Horizontal Datum
.Document.Forms("dataForm").elements("datum").Value = Datum 'NAD83/NAD27

'Site Elevation
.Document.Forms("dataForm").elements("siteElevation").Value = strElev 'Len=5 Nearest Foot

'Structure Height(AGL)
.Document.Forms("dataForm").elements("unadjustedAgl").Value = strHgt 'Len=4 Nearest Foot

'Traverseway
'NO=No Traverseway, IH=Interstate Highway, PR=Private Road, PH=Public Roadway, RR=Railroad, WW=Waterway
Select Case strTraverseway
Case "No Traverseway"
TW = "NO"
Case "Interstate Highway"
TW = "IH"
Case "Private Road"
TW = "PR"
Case "Public Roadway"
TW = "PH"
Case "Railroad"
TW = "RR"
Case "Waterway"
TW = "WW"
Case Else
MsgBox "Missing 'Traverseway' information. Correct and re-run."
Exit Sub
End Select
.Document.Forms("dataForm").elements("traverseway").Value = TW


'Is structure on airport
Select Case strOnAirport
Case "Yes"
.Document.all("onAirport")(1).Checked = True 'true/false
Case "No"
.Document.all("onAirport")(0).Checked = True 'true/false
Case Else
MsgBox "Missing 'On Airport?' information. Correct and re-run."
Exit Sub
End Select

.Document.all("submit").Click
Application.Wait (Now + TimeValue("00:00:01"))
.Document.all("submit").Click


Do While CBool(InStrB(1, .Document.URL, _
"action=showNoNoticeRequiredToolForm"))
DoEvents
Loop
Do While .busy: DoEvents: Loop
Do While .ReadyState <> 4: DoEvents: Loop


If SaveImg = vbYes Then
imgURL = .Document.images("map").src
strPath = strLocalPath & "\" & strStr & ".png"

Ret = URLDownloadToFile(0, imgURL, strPath, 0, 0)

If Ret <> 0 Then
MsgBox "Unable to download the file"
End If
End If

webpage = .Document.body.innerText
webpage = Replace(webpage, Chr(10), Chr(13))
arrWebpage = Split(webpage, Chr(13))

x = 0
strResult = ""
For y = LBound(arrWebpage) To UBound(arrWebpage)
If arrWebpage(y) <> "" Then
If x > 0 Then
If InStr(arrWebpage(y), "FAA.gov") <> 0 Then
x = 0
Else
strResult = strResult & arrWebpage(y) & Chr(10)
End If
End If

If InStr(arrWebpage(y), "Results") <> 0 Then
x = x + 1
End If
End If
Next

Worksheets("StrList").Range("L" & r) = strResult
' strResult = Left(strResult, Len(strResult) - 3)


If SavePDF = vbYes Then
.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER
End If

.Quit
End With
Worksheets("StrList").Range("N" & r).Value = Now

r = r + 1
Loop

'SetDefaultPrinter (CurrentDefaultPrinter)
MsgBox "Done!"


End Sub

[Moderator Note: I removed all the Color tags from the Code, Since They don't even work inside Code Formatting Tags.]

I put the code I switched around/added in Green (it has the code dialogue surrounding it). The red is the code which I was getting an error for. Finally, when I can get the program to run through it enters some blank cells for the results periodically, why is this happening?

Leith Ross
06-21-2017, 09:25 AM
Hello sflash11,

Which version of Windows do you have installed?

Which version of Office are you using?

Aside from the run-time error 5, what other problems have you experienced?

sflash11
06-21-2017, 09:38 AM
Hi Leith,

I am using windows 7 and am operating in MS Excel 2013.

Aside from the run-time error 5 I am having issues with my Results column on the StrList sheet getting a blank input in some of the boxes for the lines I am running. Not many, maybe 6/440 at most, but it varies when I run the program. I sometimes run into another run-time error 424. Finally I will get an error on the FAA website side occasionally and have to start the program over again. I wouldn't think that's a fixable error on the excel side of things.

SamT
06-21-2017, 01:21 PM
I have never bothered to memorize all the gazzilions of Error numbers and what they mean. I have thought about writing some vba to display the messages, but I would have to do it for all eleventyseven MS programs, and that is just too much.

So... What are the messages associated with Runtime error 5 and 424?

mdmackillop
06-21-2017, 01:37 PM
Cribbed here (https://msdn.microsoft.com/en-us/library/ka13cy19(v=vs.90).aspx)

Sub Errors()
Dim arr, a
Dim Msg As String
arr = Array(5, 424)
For Each a In arr
On Error Resume Next
Err.Clear
Err.Raise (a)
Msg = "Error #" & Str(Err.Number) & " was generated by " _
& Err.Source & vbNewLine & Err.Description
MsgBox Msg, , "Error"
Next a
End Sub

SamT
06-21-2017, 01:42 PM
Some notes about your code style.
Dimming Row and Column Counters as Integers can be a fatal error; Always declare them as Longs.

As much as possible, move sections of code to functions or other subs. It makes troubleshooting so much easier. not to mention compacting the main Procedure and getting rid of superfluous variables therein,

For Example

'Main Code
'...
Datum = GetDatum
'...

Private Function GetDatum() As String
Do Until GetDatum <> ""
Select Case InputBox("Type '1' for NAD83 and '2' for NAD27")
Case is = 1: GetDatum = "NAD83"
Case is =2: GetDatum = "NAD27"
Case Else
MsgBox "Incorrect 'Datum' selected. Please select NAD83 or NAD27."
End Select
Loop
End Function

sflash11
06-22-2017, 06:07 AM
I believe I got my variables changed over to longs, however when running the program I got another run-time error 424


Sub FAANotice() Dim strTable As String
Dim Datum As String, strDatum As String, strStr As String, strLat As String, strLong As String, strElev As String, strHgt As String, strTraverseway As String, strOnAirport As String
Dim dpos As String, mpos As String, spos As String, dpos1 As String, mpos1 As String, spos1 As String
Dim latDir As String, latD As String, latM As String, latS As String
Dim longDir As String, longD As String, longM As String, longS As String
Dim TW As String
Dim imgURL As String, webpage As String, strResult As String
Dim strDesktop As String, strLocalPath As String, strPath As String
Dim arrWebpage() As String
Dim r As Long, x As Long, y As Long, SavePDF, SaveImg, c As Long
Dim fldr As FileDialog
Dim LastRow As Long
Dim Prt
Dim CurrentDefaultPrinter As String, DefaultPrinter As String

My Error 424 was as follows:

strStr = Worksheets("StrList").Range("B" & r).Value strLat = Worksheets("StrList").Range("I" & r).Value
strLong = Worksheets("StrList").Range("H" & r).Value
strElev = Round(Worksheets("StrList").Range("F" & r).Value, 0)
strHgt = Round(Worksheets("StrList").Range("G" & r).Value, 0)
strTraverseway = Worksheets("StrList").Range("J" & r).Value
strOnAirport = Worksheets("StrList").Range("K" & r).Value

'124d15'49.676"W

dpos = InStr(strLat, "d")
mpos = InStr(strLat, "'")
spos = InStr(strLat, Chr(34))
latDir = Right(strLat, 1)
latD = Left(strLat, dpos - 1)
latM = Mid(strLat, dpos + 1, mpos - dpos - 1)
latS = Round(Val(Mid(strLat, mpos + 1, spos - dpos - 1)), 2)

dpos1 = InStr(strLong, "d")
mpos1 = InStr(strLong, "'")
spos1 = InStr(strLong, Chr(34))
longDir = Right(strLong, 1)
longD = Left(strLong, dpos1 - 1)
longM = Mid(strLong, dpos1 + 1, mpos1 - dpos1 - 1)
longS = Round(Val(Mid(strLong, mpos1 + 1, spos1 - mpos1 - 1)), 2)

With CreateObject("InternetExplorer.Application")
.Navigate "https://oeaaa.faa.gov/oeaaa/external/gisTools/gisAction.jsp?action=showNoNoticeRequiredToolForm"
.Visible = True
Do While .busy: DoEvents: Loop
Do While .ReadyState <> 4: DoEvents: Loop

'Latitude
.Document.Forms("dataForm").elements("latD").Value = latD 'Len=2
.Document.Forms("dataForm").elements("latM").Value = latM 'Len=2
.Document.Forms("dataForm").elements("latS").Value = latS 'Len=5
.Document.Forms("dataForm").elements("latDir").Value = latDir 'N/S

'Longitude
.Document.Forms("dataForm").elements("longD").Value = longD 'Len=3
.Document.Forms("dataForm").elements("longM").Value = longM 'Len=2
.Document.Forms("dataForm").elements("longS").Value = longS 'Len=5
.Document.Forms("dataForm").elements("longDir").Value = longDir 'W/E

'Horizontal Datum
.Document.Forms("dataForm").elements("datum").Value = Datum 'NAD83/NAD27


........



'Is structure on airport
Select Case strOnAirport
Case "Yes"
.Document.all("onAirport")(1).Checked = True 'true/false
Case "No"
.Document.all("onAirport")(0).Checked = True 'true/false
Case Else
MsgBox "Missing 'On Airport?' information. Correct and re-run."
Exit Sub
End Select

.Document.all("submit").Click
Application.Wait (Now + TimeValue("00:00:01"))
.Document.all("submit").Click
I got the error on the last line
.Document.all("submit").click I have also received another one today for
.Document.Forms("dataForm").elements("latD").Value = latD 'Len=2 I've attached the message popup from the FAA website in case that helps.

SamT
06-22-2017, 07:01 AM
1) place "Option Explicit" at the top of all your code pages
2) Compile often while coding
3) try increasing the wait time to a known too large number, like 30 seconds. If that "fixes" the problem, start reducing the wait time to a lesser value
4) did you read that AIM popup?
5) implement and try the suggestions offered here before asking for more

@ Dr, Mack, Thanks

@ All, RT error 424 is "Object required"

sflash11
06-22-2017, 07:38 AM
Hi SamT, I have my macro as "Option Explicit" already. I am unsure of what you mean by compile often when coding (I just started coding a couple weeks ago with this document being my first experience) can you explain/give me tips for that if possible? I have been getting the AIM popup for two weeks now and am able to run it without getting the message, so I have to think that is an error with processing the information. Thank you for your help.

SamT
06-22-2017, 08:27 AM
AIM is working on their website. getting the popup means that you are successfully navigating there, It also means their site is down at that time.



VBA Editor setup:
Under Tools >>Options,
Editor tab; Check all boxes in the Code Settings Frame. I set my Tab Width = 2, YMMV
General Tab; Check Break on all errors, and all boxes outside that Frame.

Compiling: Under Debug, click Compile VBA Project.

Compile when you have a small section of code completed. Fix all errors before writing more code. Sometimes an error will occur just because you haven't gotten that far yet. Sometimes, I comment out that line just long enough to compile the rest for error checking, sometimes I realize it doesn't matter ATT and write more code.

As I mentioned before, but will emphasize now, you really, really need to place as much code into separate procedures as possible, besides the GetData? Function I used as an example, I remember that the SaveAsPDF code can be extracted to a separate Sub. as can the SaveImg code.

See the attachemnt in my last post in http://www.vbaexpress.com/forum/showthread.php?59828 for a simple example. Note that sometimes, when a Variable is used in many procedures, it can be useful to set their Scope, module wide, ie, outside of and before any procedures.

Placing the cursor inside a sub and pressing F5 will run that sub, Pressing F8 will step thru, (execute one line at a time) the code.Note: the yellow highlighted line of running code is the NEXT line to be executed

After setting up the editor as mentioned above, when you hover over a variable, a ToolTip will show the variable's current value,\. With that knowledge, I mostly use "Dim x," and x = someprocess or bit of info that will tell me a piece of code is working. Ex:

set MyTable = Range("A1:C3")
dim x
x = MyTable.Address


At the left edge of the code module is a vertical grey bar, clicking that bar next to a line of code will pause the execution at that line, (sets a BreakPoint,) then you can step thru the code with F8 and watch what is going on.

With that info, see the Example just above: set a Breakpoint at x = MyTable.Address, and run the code normally, when it pauses, press F8 to run just the x = MyTable.Address line and hover over the "x". Press F5 to continue running the code normally to the next BreakPoint.

If you Right Click a Variable, you can set a Watch on it and it's value will be shown below the Code Page.

sflash11
06-22-2017, 09:16 AM
I hate to have to ask you to dumb it down more, but can you dumb it down more and use examples from my document. I have enough of an understanding of the stepping through the debugger with F8 and running the code with F5. I know the grey bar as well.

I'm very confused on how to proceed with this. Here is my document so far

Leith Ross
06-29-2017, 08:19 PM
Hello sflash11,

Sorry for the long delay in replying. After studying the code and learning about the website and how it functions, I decided it would be easier to rewrite the code. Internet Explorer was never meant to be automated in VBA. It is a standalone application that runs asynchronously from the VBA environment. This lack of synchronization makes it impossible to reliably receive data.

This version has a UserForm with an ActiveX WebBrowser object. This control works synchronously with the VBA environment. The code has been written to handle various errors and report them in the Results columns "L:M" on the sheet. They appear in the "Bad" Style: red font and pink cell interior colors. If there are no errors and the user has chosen to save the map then it will be saved to a folder named "FAA Maps" on the user's Desktop. If the folder does not exist, it will be created automatically. If a file with the same name already exists in the folder, it will be overwritten with no warning.

The UserForm cycles through the data on the sheet "StrList" row by row filling in the site's data form and submitting it. Module2 contains other macros to support the UserForm's data extraction and handling. This makes it easier to maintain and provide more functionality without the need to rewrite the main macro. The UserForm now can be minimized and restored to get it out of the way. The UserForm is displayed non-modally so you can use Excel while the macro runs.

I have run this macro many times have had very few errors. The most common being thee map is missing. Test it out on your end and let me know how it works for you.

sflash11
06-30-2017, 08:30 AM
Hi Leith,

Thank you for taking the time to look over this so thoroughly. Unfortunately when I tried running it for the first time I came across this error.



Global MapPath As String
Global SavePDF As Boolean
Global SaveMap As Boolean


Private Declare PtrSafe Function DownloadToFile _
Lib "urlmon.dll" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) _
As Long


'Returns the Window Handle of the Window accepting input
Public Declare Function GetForegroundWindow Lib "user32.dll" () As Long


Private Declare Function GetWindowLong _
Lib "user32.dll" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) _
As Long

Private Declare Function SetWindowLong _
Lib "user32.dll" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long

'Redraw the Icons on the Window's Title Bar
Private Declare Function DrawMenuBar Lib "user32.dll" (ByVal hWnd As Long) As Long

I'm not sure what it means, if you could offer any suggestions I would greatly appreciate it.

Leith Ross
06-30-2017, 08:50 AM
Hello sflash11,

Not a big deal. Older Windows systems ran on a 32 bit architecture. Most newer computer can run either 32 bit or 64 bit Windows. But some systems like yours are only 64 bit.

I will update the API code for a 64 bit system and post the updated workbook.

Leith Ross
06-30-2017, 09:25 AM
Hello sflash11,

Here is the updated workbook. This should fix any API issues. Try it and let me know.

sflash11
06-30-2017, 09:37 AM
Hi Leith,

I am still getting a compiling error. I've attached the message and code behind it.

Leith Ross
06-30-2017, 09:39 AM
Hello sflash11,

The code shown in your post #16 does not match the current code in the workbook I posted.

sflash11
06-30-2017, 09:52 AM
Hi Leith,

When I open the most recent file you put in here this is what pops up when I try to run the macro, I'm unsure how this could be different.

Leith Ross
06-30-2017, 10:02 AM
Hello sflash11,

The most recent workbook I posted is version 2A. The previous version was 2. The current code uses conditional compilation to determine which set of API declarations will be used. Here is what the current code looks like.



Global MapPath As String
Global SavePDF As Boolean
Global SaveMap As Boolean


' NOTE: Compile the API declarations according to 32 bit or 64 bit architecture.


#If Win64 Then
Private Declare PtrSafe Function DownloadToFile _
Lib "urlmon.dll" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As LongPtr) _
As Long


'Returns the Window Handle of the Window accepting input
Public Declare PtrSafe Function GetForegroundWindow Lib "user32.dll" () As LongPtr


Private Declare PtrSafe Function GetWindowLongPtr _
Lib "user32.dll" Alias "GetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long) _
As LongPtr

Private Declare PtrSafe Function SetWindowLongPtr _
Lib "user32.dll" Alias "SetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) _
As LongPtr

'Redraw the Icons on the Window's Title Bar
Private Declare PtrSafe Function DrawMenuBar Lib "user32.dll" (ByVal hWnd As LongPtr) As Long

#Else
Private Declare Function DownloadToFile _
Lib "urlmon.dll" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) _
As Long


'Returns the Window Handle of the Window accepting input
Public Declare Function GetForegroundWindow Lib "user32.dll" () As Long


Private Declare Function GetWindowLong _
Lib "user32.dll" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) _
As Long

Private Declare Function SetWindowLong _
Lib "user32.dll" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long

'Redraw the Icons on the Window's Title Bar
Private Declare Function DrawMenuBar Lib "user32.dll" (ByVal hWnd As Long) As Long
#End If


The 32 bit declarations (those without PtrSafe) will be skipped if your machine runs 64 bit Windows. You should not see any compilation errors with this code. I am running Windows 7 with WOW64. My machine will work wither 32 or 64 bit API code. This version works successfully on my machine.