Internet-Datei per vba ansteueren und speichern

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Frame MsgBox
Bild

Betrifft: Internet-Datei per vba ansteueren und speichern
von: Andrea
Geschrieben am: 16.03.2005 17:54:43
Hallo aus Bremen,
möchte per vba InternetDatei auf meiner Festplatte speichern.
Kann mir jemand helfen.
Vielen Dank
Andrea

Bild

Betrifft: AW: Internet-Datei per vba ansteueren und speichern
von: Nepumuk
Geschrieben am: 16.03.2005 18:12:41
Hallo Andrea,
nur die Seite, oder einen Datei-Download?
Gruß
Nepumuk
Bild

Betrifft: AW: Internet-Datei per vba ansteueren und speichern
von: Andrea
Geschrieben am: 16.03.2005 18:24:52
Hallo Nepumuk,
nur die Seite, eigentlich handelt es sich um eine Excel-Liste mit JPG-Dateinamen.
vielen Dank und Grüsse
Andrea
Bild

Betrifft: AW: Internet-Datei per vba ansteueren und speichern
von: Nepumuk
Geschrieben am: 16.03.2005 19:49:02
Hallo Andrea,
sollen die Dateinamen in die Excelmappe importiert werden? Soll die Verbindung zum Internet per Makro erfolgen und anschließend wieder getrennt werden? Wie lautet dir URL der Seite, damit ich es auch testen kann?
Gruß
Nepumuk
Bild

Betrifft: AW: Internet-Datei per vba ansteueren und speichern
von: Andrea
Geschrieben am: 16.03.2005 21:51:42
Hallo Nepumuk,
nein, die Dateinamen, habe ich schon mittels eines Macros in meine Excelliste importiert. Nun möchte ich noch die daraus resultierenden Produktfotos/Adressen ansteuern und abspeichern. Die da z.B.
wären: http://www.peschls-in-bremerhaven.de/catalog/images/GSX-R750ab00.jpg.
Das wärs eigentlich. Internet-Verbindung braucht nicht hergestellt zu werden.
Danke und Grüsse
Andrea
Bild

Betrifft: AW: Internet-Datei per vba ansteueren und speichern
von: Nepumuk
Geschrieben am: 16.03.2005 22:25:46
Hallo Andrea,
das habe ich befürchtet. Denn das einzige was nicht automatisch, sprich ohne zutun des Users geht, sind Bilder aus Internetseiten zu extrahieren.
Da diese aber in den Temporären Internetdateien gespeichert werden, könnte ich dir ein kleines Programm schreiben, welches die Bilder dort herausholt. Wäre das Ok?
Hast du ein Programm, mit dem du die Seiten öffnest, oder benötigst du einen Beispielcode dazu?
Gruß
Nepumuk
Bild

Betrifft: AW: Internet-Datei per vba ansteueren und speichern
von: Andrea
Geschrieben am: 17.03.2005 07:07:07
Guten Morgen Nepumuk,
das hört sich super an. Ich hab es mir übrigens auch schon fast gedacht und komme daher auf Dein Angebot zurück. Mit meinem Programm kann ich nur HTML-Seiten aufrufen & auslesen aber irgendwie reicht das nicht dafür, die jpg.datein anzusteuern und auch noch ins Temporäre Verzeichnis zu bekommen. Ich denke, da brauch ich wohl wirklich einen komplett neuen Code. Wenn Du mir da helfen könntest, wäre das super.
Vielen Dank und viele Grüsse
Andrea
Bild

Betrifft: AW: Internet-Datei per vba ansteueren und speichern
von: Nepumuk
Geschrieben am: 17.03.2005 08:11:54
Auch einen guten Morgen,
das speichern von Webinhalten in den Temporären Internetdateien geschieht automatisch, um die Seite Offline aufrufen zu können. Du benötigst also nur eine kleine Routine, welche eine Seite nach der anderen aufruft um die Bilder in den Ordner zu bekommen. Mit VBA - gut, solltest du dir diese so umbauen können.


Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" ( _
     ByVal dwMilliseconds As Long)
Public Sub URL_Load()
    Dim myIE_App As Object
    Set myIE_App = CreateObject("InternetExplorer.Application")
    myIE_App.Visible = True
    myIE_App.Navigate "http://www.peschls-in-bremerhaven.de/catalog/images/GSX-R750ab00.jpg"
    Do
        Sleep 100
    Loop Until myIE_App.Busy = False
End Sub


Das herausholen der Bilder ist ein bisschen komplizierter. Ich habe es so geschrieben, dass du nur die Routine "Start" anpassen musst. Das Sternchen im Dateinamen "GSX-R750ab00*.jpg" dient als Platzhalter, da die Bilder beim speichern in den Temp - Ordnern mit einem Index versehen werden. Der Originalname "GSX-R750ab00.jpg" wird dabei so geändert "GSX-R750ab00[1].jpg". Es wäre günstig, wenn du den Ordner vor dem herunterladen der Bilder löschst, da sich darin meistens einige tausend Dateien befinden und die Suche dann etwas länger dauert. Einfach im Explorer Extras - Internetoptionen - Allgemein - Dateien löschen.


Option Explicit
Private Declare Function GetWindow Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal wCmd As Long _
    ) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As LongByVal _
    pszPath As StringAs Long
Private Declare Function SHGetSpecialFolderLocation Lib _
    "shell32.dll" (ByVal hwndOwner As LongByVal nFolder _
    As Long, pidl As ITEMIDLIST) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias _
    "GetTempPathA" (ByVal nBufferLength As LongByVal _
    lpBuffer As StringAs Long
    
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
     ByVal lpClassName As String, _
     ByVal lpWindowName As StringAs Long
Private Declare Function FindClose Lib "kernel32.dll" ( _
     ByVal hFindFile As LongAs Long
Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" ( _
     ByVal hFindFile As Long, _
     ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" ( _
     ByVal lpFileName As String, _
     ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const R_TEMP_INTERNET = &H20
Private Const NOERROR = 0
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
Private Type ITEMID
    cb As Long
    abID As Byte
End Type
Private Type ITEMIDLIST
    mkid As ITEMID
End Type
Private strFile As String
Private bolfound As Boolean
Public Sub start()
    Dim strPath As String
    strPath = GetPath(R_TEMP_INTERNET) & "\"
    Call FindFiles(strPath, "GSX-R750ab00*.jpg")
    If Not bolfound Then
        MsgBox "Keine Datei gefunden.", 48, "Hinweis"
    Else
        ActiveSheet.Pictures.Insert strFile
    End If
End Sub
Private Sub FindFiles(ByVal strFolderPath As StringByVal strSearch As String)
    Dim WFD As WIN32_FIND_DATA
    Dim lngSearch As Long
    Dim strDirName As String
    If Right$(strFolderPath, 1) <> "\" Then strFolderPath = strFolderPath & "\"
    lngSearch = FindFirstFile(strFolderPath & "*.*", WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
        GetFilesInFolder strFolderPath, strSearch
        Do
            If bolfound Then Exit Do
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
                strDirName = TrimNulls(WFD.cFileName)
                If (strDirName <> ".") And (strDirName <> "..") Then _
                    FindFiles strFolderPath & strDirName, strSearch
            End If
        Loop While FindNextFile(lngSearch, WFD)
        FindClose lngSearch
    End If
End Sub
Private Sub GetFilesInFolder(ByVal strFolderPath As StringByVal strSearch As String)
    Dim WFD As WIN32_FIND_DATA
    Dim lngSearch As Long
    Dim strFileName As String
    If Right$(strFolderPath, 1) <> "\" Then strFolderPath = strFolderPath & "\"
    lngSearch = FindFirstFile(strFolderPath & strSearch, WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
        Do
            If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY Then
                strFileName = TrimNulls(WFD.cFileName)
                bolfound = True
                strFile = strFolderPath & strFileName
                Exit Do
            End If
        Loop While FindNextFile(lngSearch, WFD)
        FindClose lngSearch
    End If
End Sub
Private Function TrimNulls(ByVal strStringIn As StringAs String
    If InStr(strStringIn, Chr(0)) > 0 Then strStringIn = _
        Left$(strStringIn, InStr(strStringIn, Chr(0)) - 1)
    TrimNulls = strStringIn
End Function
Private Function GetPath(Num&) As String
    Dim Result&, Buff$
    Dim idl As ITEMIDLIST
    Result = SHGetSpecialFolderLocation(FindWindow("XLMAIN", vbNullString), Num, idl)
    If Result = NOERROR Then
        Buff = Space$(512)
        Result = SHGetPathFromIDList(ByVal idl.mkid.cb, ByVal Buff)
        If Result Then
            GetPath = Trim$(Buff)
            GetPath = Left$(GetPath, Len(GetPath) - 1)
        End If
    End If
End Function


Gruß
Nepumuk
Bild

Betrifft: AW: Danke Nepumuk
von: Andrea
Geschrieben am: 17.03.2005 08:51:04
Hallo Nepumuk,
verneige mich - werd jetzt schnell zur Arbeit fahren und es dort ausprobieren. Routine einbauen um Dateien nacheinander "abzuklappern" - bekomme ich hin.
Ich danke Dir, Du hast mich wahrscheinlich einen Riesenschritt voranngebracht. Melde mich nachher noch einmal.
Grüsse
Andrea
Bild

Betrifft: AW: Nepumuk verat mir bitte noch eins
von: Andrea
Geschrieben am: 17.03.2005 12:58:10
Hallo Nepumuk,
bitte schreib mir noch, wie ich den Internetexplorer nach dem Laden wieder schließen kann. Kann ich mit einem Befehl die Lade-Prozedur auch im Hintergrund laufen lassen?
Ansonsten läuft das Prog schon mal super.
Vielen Dank und viele Grüsse
Andrea
Bild

Betrifft: AW: Nepumuk verat mir bitte noch eins
von: Nepumuk
Geschrieben am: 17.03.2005 14:22:19
Hallo Andrea,
du musst doch nicht jedes mal ein neues Explorerfenster öffnen. Mal ein Beispiel. Deine Bildernamen stehen in Spalte A ab Zeile 2. Dann sieht die Schleife so aus:


Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" ( _
     ByVal dwMilliseconds As Long)
     
Public Sub URL_Load()
    Dim myIE_App As Object, lngRow As Long
    Set myIE_App = CreateObject("InternetExplorer.Application")
    myIE_App.Visible = True
    For lngRow = 2 To Cells(Rows.Count, 1).End(-4162).Row
        myIE_App.Navigate "http://www.peschls-in-bremerhaven.de/catalog/images/" & Cells(lngRow, 1)
        Do
            Sleep 100
        Loop Until myIE_App.Busy = False
    Next
End Sub


Wenn der Prozess einmal läuft, dann kannst du das Explorerfenster minimieren. Das geht auch mit einer Routine:


Option Explicit
Private Declare Function SetWindowPlacement Lib "user32.dll" ( _
     ByVal hwnd As Long, _
     ByRef lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function GetWindowPlacement Lib "user32.dll" ( _
     ByVal hwnd As Long, _
     ByRef lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As StringAs Long
Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" ( _
    ByVal hwnd As Long, _
    ByVal lpString As String, _
    ByVal cch As LongAs Long
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _
    ByVal hwnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As LongAs Long
Private Declare Function GetWindow Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal wCmd As LongAs Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As LongAs Long
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" ( _
    ByVal hwnd As LongAs Long
Private Type POINTAPI
        x As Long
        y As Long
End Type
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Type WINDOWPLACEMENT
        Length As Long
        flags As Long
        showCmd As Long
        ptMinPosition As POINTAPI
        ptMaxPosition As POINTAPI
        rcNormalPosition As RECT
End Type
Private Const SW_MINIMIZE As Long = 6
Private Const GW_HWNDFIRST As Long = 0
Private Const GW_HWNDNEXT As Long = 2
Private Const GWL_STYLE As Long = -16
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_BORDER As Long = &H800000
Private Const gcClassnameMSIExplorer = "IEFrame"
Public Sub IE_minimize()
    Dim lng_hwnd As Long, lng_style As Long
    Dim lpClassName As String, RetVal As Long
    Dim WinEst As WINDOWPLACEMENT, Points As POINTAPI
    Points.x = 100
    Points.y = 100
    WinEst.Length = Len(WinEst)
    lpClassName = Space(256)
    lng_hwnd = GetWindow(FindWindow(vbNullString, vbNullString), GW_HWNDFIRST)
    Do
        lng_style = GetWindowLong(lng_hwnd, GWL_STYLE) And (WS_VISIBLE Or WS_BORDER)
        If (lng_style = (WS_VISIBLE Or WS_BORDER)) = True And Trim$(GetWindowTitle(lng_hwnd)) <> "" Then
            RetVal = GetClassName(lng_hwnd, lpClassName, 256)
            If gcClassnameMSIExplorer = Left$(lpClassName, RetVal) Then
                GetWindowPlacement lng_hwnd, WinEst
                WinEst.showCmd = SW_MINIMIZE
                WinEst.ptMinPosition = Points
                WinEst.ptMaxPosition = Points
                SetWindowPlacement lng_hwnd, WinEst
            End If
        End If
        lng_hwnd = GetWindow(lng_hwnd, GW_HWNDNEXT)
    Loop Until lng_hwnd = 0
End Sub
Private Function GetWindowTitle(ByVal lng_hwnd As LongAs String
    Dim lng_result As Long, str_temp As String
    lng_result = GetWindowTextLength(lng_hwnd) + 1
    str_temp = Space(lng_result)
    lng_result = GetWindowText(lng_hwnd, str_temp, lng_result)
    GetWindowTitle = Left(str_temp, Len(str_temp) - 1)
End Function


Mit der selben Routine, nur einer anderen Anweisung, lässt sich der Explorer auch schließen:


Option Explicit
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As StringAs Long
Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" ( _
    ByVal hwnd As Long, _
    ByVal lpString As String, _
    ByVal cch As LongAs Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As LongAs Long
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _
    ByVal hwnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As LongAs Long
Private Declare Function GetWindow Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal wCmd As LongAs Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As LongAs Long
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" ( _
    ByVal hwnd As LongAs Long
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private Const GWL_STYLE = -16
Private Const WS_VISIBLE = &H10000000
Private Const WS_BORDER = &H800000
Private Const WM_CLOSE = &H10
Private Const gcClassnameMSIExplorer = "IEFrame"
Public Sub IE_close()
    Dim lng_hwnd As Long, lng_style As Long
    Dim lpClassName As String, RetVal As Long
    lpClassName = Space(256)
    lng_hwnd = GetWindow(FindWindow(vbNullString, vbNullString), GW_HWNDFIRST)
    Do
        lng_style = GetWindowLong(lng_hwnd, GWL_STYLE) And (WS_VISIBLE Or WS_BORDER)
        If (lng_style = (WS_VISIBLE Or WS_BORDER)) = True And Trim$(GetWindowTitle(lng_hwnd)) <> "" Then
            RetVal = GetClassName(lng_hwnd, lpClassName, 256)
            If gcClassnameMSIExplorer = Left$(lpClassName, RetVal) Then PostMessage lng_hwnd, WM_CLOSE, 0&, 0&
        End If
        lng_hwnd = GetWindow(lng_hwnd, GW_HWNDNEXT)
    Loop Until lng_hwnd = 0
End Sub
Private Function GetWindowTitle(ByVal lng_hwnd As LongAs String
    Dim lng_result As Long, str_temp As String
    lng_result = GetWindowTextLength(lng_hwnd) + 1
    str_temp = Space(lng_result)
    lng_result = GetWindowText(lng_hwnd, str_temp, lng_result)
    GetWindowTitle = Left(str_temp, Len(str_temp) - 1)
End Function


Die Kombination der drei Makros ergibt dann folgendes:


Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" ( _
     ByVal dwMilliseconds As Long)
Public Sub URL_Load()
    Dim myIE_App As Object, lngRow As Long
    Set myIE_App = CreateObject("InternetExplorer.Application")
    myIE_App.Visible = True
    Call IE_minimize
    For lngRow = 2 To Cells(Rows.Count, 1).End(-4162).Row
        myIE_App.Navigate "http://www.peschls-in-bremerhaven.de/catalog/images/" & Cells(lngRow, 1)
        Do
            Sleep 100
        Loop Until myIE_App.Busy = False
    Next
    Call IE_close
End Sub


Wobei die Routine zum minimieren und zum schließen in eigene Module kommen.
Gruß
Nepumuk
P.S. Hoffentlich habe ich dich nun nicht mit API erschlagen, aber wie du siehst, kann aus Excel heraus Windows bequem gesteuert werden.
Bild

Betrifft: AW: Klasse!
von: Andrea
Geschrieben am: 17.03.2005 15:20:12
Hallo Nepumuk,
hab mir nun zwischendurch auch einen Code gebastelt (öffnen/schließen/öffnen/schließen...;-)usw.)
Und jetzt sehe ich Deinen Code und binn platt. Werd´s gleich ausprobieren.
Bis hierhin schon mal vielen DANK. Es war genau das, was ich brauchte.
viele Grüsse aus Bremen
Andrea
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Internet-Datei per vba ansteueren und speichern"