باز کردن وبسایت در محیط vb

کد:
Download a file from the internet (without a prompt dialog)



The following routine downloads a file from the internet without prompting the user first.



Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer





'Purpose     :  Retreview text from a web site

'Inputs      :  sURLFileName            The URL and file name to download.

'               sSaveToFile             The filename to save the file to.

'               [bOverwriteExisting]    If True overwrites the file if it existings

'Outputs     :  Returns True on success.





Function InternetGetFile(sURLFileName As String, sSaveToFile As String, Optional bOverwriteExisting As Boolean = False) As Boolean

    Dim lRet As Long

    Const S_OK As Long = 0, E_OUTOFMEMORY = &H8007000E

    Const INTERNET_OPEN_TYPE_PRECONFIG = 0, INTERNET_FLAG_EXISTING_CONNECT = &H20000000

    Const INTERNET_OPEN_TYPE_DIRECT = 1, INTERNET_OPEN_TYPE_PROXY = 3

    Const INTERNET_FLAG_RELOAD = &H80000000

    

    On Error Resume Next

    'Create an internet connection

    lRet = InternetOpen("", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)

    

    If bOverwriteExisting Then

        If Len(Dir$(sSaveToFile)) Then

            VBA.Kill sSaveToFile

        End If

    End If

    'Check file doesn't already exist

    If Len(Dir$(sSaveToFile)) = 0 Then

        'Download file

        lRet = URLDownloadToFile(0&, sURLFileName, sSaveToFile, 0&, 0)

        If Len(Dir$(sSaveToFile)) Then

            'File successfully downloaded

            InternetGetFile = True

        Else

            'Failed to download file

            If lRet = E_OUTOFMEMORY Then

                Debug.Print "The buffer length is invalid or there was insufficient memory to complete the operation."

            Else

                Debug.Assert False

                Debug.Print "Error occurred " & lRet & " (this is probably a ....... server error)."

            End If

            InternetGetFile = False

        End If

    End If

    On Error GoTo 0

    

End Function



'Demonstration routine, downloads an image from vbusers.com

'to the c: drive

Sub Test()

    If InternetGetFile("http://filename", "c:\filename", True) Then

        MsgBox "Successfully downloaded file!"

    Else

        MsgBox "Failed to download file!"

    End If

End Sub