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
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 Long, ByVal _
pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib _
"shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder _
As Long, pidl As ITEMIDLIST) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias _
"GetTempPathA" (ByVal nBufferLength As Long, ByVal _
lpBuffer As String) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function FindClose Lib "kernel32.dll" ( _
ByVal hFindFile As Long) As 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 String, ByVal 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 String, ByVal 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 String) As 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
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
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 String) As Long
Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" ( _
ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _
ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function GetWindow Lib "user32.dll" ( _
ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" ( _
ByVal hwnd As Long) As 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 Long) As 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
Option Explicit
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" ( _
ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As 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 Long) As Long
Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _
ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function GetWindow Lib "user32.dll" ( _
ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" ( _
ByVal hwnd As Long) As 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 Long) As 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
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
