| |
 |
| - - - - - - - - - - - - - - ผู้ให้การสนับสนุน- - - - - - - - - - - - - -
|
|
|
กระทู้ #2056 [Vb] (จาก IP: 62.107.207.175)
อยากได้ Code Vb ที่ link ไปยัง web ที่่เราต้องการ
ไม่รู้จริงๆ
|
| จากคุณ
:
Jsp / jsp874@yahoo.com [2008-06-08 21:02:58]
|
|
ความคิดเห็น #26841 (จาก IP: 58.8.251.38)
Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.Navigate "http://www.windowsupdate.com"
.Visible = True
End With
Set objIE = Nothing |
| จากคุณ
:
sup98 [2008-06-08 23:28:30]
|
|
ความคิดเห็น #26842 (จาก IP: 58.8.251.38)
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Public Function LaunchInNewwindow(sURL As String) As Boolean
Const SW_SHOWNORMAL = 1
Dim lRetVal As Long
Dim sTemp As String
Dim sBrowserExec As String
sBrowserExec = GetBrowserExe 'get the exe
sURL = AddHTTP(sURL)
lRetVal = ShellExecute(GetDesktopWindow(), "open", sBrowserExec, sURL, sTemp, SW_SHOWNORMAL)
' lRetVal = ShellExecute(frm.hWnd, "open", sURL, "", sTemp, SW_SHOWNORMAL) '1998/07/31 This works as well
If lRetVal > 32 Then ' OK
LaunchInNewwindow = True
End If
End Function
Private Function AddHTTP(sURL As String) As String
' 2004/12/16 Function added by Larry Rebich using the DELL8500 while in Fort McDowell, AZ
' 2004/12/16 Add http:// is none
Dim sTemp As String
sTemp = sURL
If InStr(LCase$(sTemp), "https://") = 1 Then
AddHTTP = sTemp
ElseIf InStr(LCase$(sTemp), "http://") = 1 Then
AddHTTP = sTemp
Else
AddHTTP = "http://" & sTemp
End If
End Function
Public Function GetBrowserExe() As String
Dim sFilename As String
Dim sBrowserExec As String * 255
Dim lRetVal As Long
Dim iFN As Integer
Dim sTemp As String
sBrowserExec = Space(255)
sFilename = App.Path & "\temphtm.HTM"
iFN = FreeFile() ' Get unused file number
Open sFilename For Output As #iFN ' Create temp HTML file
Print #iFN, "<HTML> <\HTML>" ' Output text
Close #iFN ' Close file
' Then find the application associated with it.
lRetVal = FindExecutable(sFilename, sTemp, sBrowserExec)
' If an application return the name
If lRetVal <= 32 Or IsEmpty(sBrowserExec) Then ' Error
Else
GetBrowserExe = Trim$(sBrowserExec)
End If
Kill sFilename ' delete temp HTML file
End FunctionOption Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Public Function LaunchInNewwindow(sURL As String) As Boolean
Const SW_SHOWNORMAL = 1
Dim lRetVal As Long
Dim sTemp As String
Dim sBrowserExec As String
sBrowserExec = GetBrowserExe 'get the exe
sURL = AddHTTP(sURL)
lRetVal = ShellExecute(GetDesktopWindow(), "open", sBrowserExec, sURL, sTemp, SW_SHOWNORMAL)
' lRetVal = ShellExecute(frm.hWnd, "open", sURL, "", sTemp, SW_SHOWNORMAL) '1998/07/31 This works as well
If lRetVal > 32 Then ' OK
LaunchInNewwindow = True
End If
End Function
Private Function AddHTTP(sURL As String) As String
' 2004/12/16 Function added by Larry Rebich using the DELL8500 while in Fort McDowell, AZ
' 2004/12/16 Add http:// is none
Dim sTemp As String
sTemp = sURL
If InStr(LCase$(sTemp), "https://") = 1 Then
AddHTTP = sTemp
ElseIf InStr(LCase$(sTemp), "http://") = 1 Then
AddHTTP = sTemp
Else
AddHTTP = "http://" & sTemp
End If
End Function
Public Function GetBrowserExe() As String
Dim sFilename As String
Dim sBrowserExec As String * 255
Dim lRetVal As Long
Dim iFN As Integer
Dim sTemp As String
sBrowserExec = Space(255)
sFilename = App.Path & "\temphtm.HTM"
iFN = FreeFile() ' Get unused file number
Open sFilename For Output As #iFN ' Create temp <strong class="highlight">HTML</strong> file
Print #iFN, "<HTML> <\HTML>" ' Output text
Close #iFN ' Close file
' Then find the application associated with it.
lRetVal = FindExecutable(sFilename, sTemp, sBrowserExec)
' If an application return the name
If lRetVal <= 32 Or IsEmpty(sBrowserExec) Then ' Error
Else
GetBrowserExe = Trim$(sBrowserExec)
End If
Kill sFilename ' delete temp <strong class="highlight">HTML</strong> file
End Function |
| จากคุณ
:
sup98 [2008-06-08 23:31:01]
|
|
|
| - - - - - - - - - - - - - - ผู้ให้การสนับสนุน- - - - - - - - - - - - - -
|
|
| |
|
|
New Article
อัตราค่าโฆษณา
