-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathFN Open Browser.vb
126 lines (75 loc) · 3.54 KB
/
FN Open Browser.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
Private Function Open_Browser(sWebsite As String, Optional bCloseBrowser As Boolean = False) As Boolean
'Make sure Microsoft Internet Controls object library is referenced
'1 Check to see if the website is already open
'Objects
Dim ShellWins As SHDocVw.ShellWindows
Dim ieApp As SHDocVw.InternetExplorer
Dim WebBrowser As SHDocVw.WebBrowser
'Instatiate object
Set ShellWins = New SHDocVw.ShellWindows
Set ieApp = New SHDocVw.InternetExplorer
'Set default value
Open_Browser = False
On Error GoTo ProcErr
If bCloseBrowser = False Then
'make sure you can see this new copy of IE!
With ieApp
.Visible = True
.Navigate sWebsite
End With
'wait for page to finish loading
Do While ieApp.Busy And Not ieApp.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
Else
' ** Close PreSale website **
'make sure you can see this new copy of IE!
'loop through browser to check for PreSalesDB
For Each WebBrowser In ShellWins
'Get address of webpages in browser
sLocation = Left(WebBrowser.LocationURL, Len(sWebsite))
'Check PreSales DB Site
If sLocation = sWebsite Then
WebBrowser.Quit
Exit For
End If
Next
End If
'Website
Open_Browser = True
ProcExit:
Set ShellWins = Nothing
Set ieApp = Nothing
Set WebBrowser = Nothing
Exit Function
ProcErr:
'Set open website to false
Open_Browser = False
Select Case Err.Number
Case 91 'Object not found Note: This occurs on the rsTrackChanges close statement
'Debug.Print " The error # is " & Err.Number & vbCrLf & "Description " & Err.Description & vbCrLf & vbCrLf & " The source " & Err.Source, vbCritical
Resume Next
Case -2147467259 'Unspecified Error
MsgBox "Error with opening Browser to Forecast Tool site!" & vbCrLf & vbCrLf & _
"Send email to the itopursuitsites@atos.net mailbox for assistance", vbInformation + vbOKOnly, _
"Function: Open_Browser Module: WinHTTP"
Debug.Print "Description " & Err.Description & vbCrLf & "The error # is " & Err.Number & vbCrLf & "The source " & Err.Source, vbCritical
Resume ProcExit
Case -2147417848 'Object invoked has disconnecte from the client
MsgBox "Error with opening Browser to Forecast Tool site!" & vbCrLf & vbCrLf & _
"Send email to the itopursuitsites@atos.net mailbox for assistance", vbInformation + vbOKOnly, _
"Function: Open_Browser Module: WinHTTP"
Debug.Print "Description " & Err.Description & vbCrLf & "The error # is " & Err.Number & vbCrLf & "The source " & Err.Source, vbCritical
Resume ProcExit
Case -2147012889 'Server name address can not be resolved
' MsgBox "Forecast Tool PreSales DB site is not found!" & vbCrLf & vbCrLf & _
' "Check your connection to the internet of open the site at the address below" & vbCrLf & vbCrLf & _
' PUBLIC_URL_PRESALES, vbExclamation + vbOKOnly, "Function: Open_Browser Module: Mod_WinHTTP"
Debug.Print "Description " & Err.Description & vbCrLf & "The error # is " & Err.Number & vbCrLf & "The source " & Err.Source, vbCritical
Resume ProcExit
Case Else
MsgBox "Description " & Err.Description & vbCrLf & "The error # is " & Err.Number & vbCrLf & "The source " & Err.Source, vbCritical
Resume ProcExit
End Select
Resume ProcExit
End Function