AW: Datei aus dem Internet runterladen
05.04.2008 06:34:36
webxite
Es liegt am Code und an dem Rechtsklick.
Ich weiß das die Deklarationen alleine nichts bringen.
Es soll eben nicht manuell geschehen sondern automatisch und wenn ich den Link in den Browser eingeben kann ich die Datei nicht einkauf runterladen da sie im geschützten bereich liegt. Aber das Problem das ich habe ist ich brauche den Code mit dem Rechtsklick.
Option Compare Database
Option Explicit
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000
Private Declare
Function InternetOpen Lib "wininet.dll" Alias _
"InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, _
ByVal lpszProxyName As String, _
ByVal lpszProxyBypass As String, _
ByVal dwFlags As Long) As Long
Private Declare
Function InternetOpenUrl Lib "wininet.dll" Alias _
"InternetOpenUrlA" (ByVal hInternetSession As Long, _
ByVal lpszUrl As String, _
ByVal lpszHeaders As String, _
ByVal dwHeadersLength As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long
Private Declare
Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
Private Declare
Function InternetReadFile Lib "wininet.dll" _
(ByVal hFile As Long, ByVal lpBuffer As String, _
ByVal dwNumberOfBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Sub CopyURLToFile(ByVal URL As String, ByVal FileName As String)
Dim hInternetSession As Long
Dim hUrl As Long
Dim DatNum As Integer
Dim ByteAnz As Long
Dim Buffer As String * 4096
Dim DatInhalt As String
On Error GoTo Fehler
If Len(URL) = 0 Or Len(FileName) = 0 Then
MsgBox "Fehlende URL"
Exit
Sub
End If
' open an Internet session, and retrieve its handle
hInternetSession = InternetOpen("dummy", INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, vbNullString, 0)
If hInternetSession = 0 Then
MsgBox "Fehler bei InternetOpen"
Exit
Sub
End If
' open the file and retrieve its handle
hUrl = InternetOpenUrl(hInternetSession, URL, vbNullString, 0, _
INTERNET_FLAG_EXISTING_CONNECT, 0)
If hUrl = 0 Then
If hInternetSession Then InternetCloseHandle hInternetSession
MsgBox "Fehler bei InternetOpenUrl"
Exit
Sub
End If
' evtl vorhandene Datei löschen
On Error Resume Next
Kill FileName
On Error GoTo Fehler
' Daten sammeln
Do
InternetReadFile hUrl, Buffer, Len(Buffer), ByteAnz
If ByteAnz = 0 Then Exit Do
DatInhalt = DatInhalt & Left(Buffer, ByteAnz)
Loop
' Datei schreiben
DatNum = FreeFile
Open FileName For Output As #DatNum
Print #DatNum, DatInhalt;
Close #DatNum
Fehler:
If hUrl Then InternetCloseHandle hUrl
If hInternetSession Then InternetCloseHandle hInternetSession
If Err Then MsgBox "Fehler " & Err.Number & ":" & Err.Description
End
Sub
Sub testen()
'CopyURLToFile "http://www.meineseite.de/test.xls" _
################# Den Code habe ich von Office-Loesungen.de