Hallo Wissende,ich muss aus den ganzen

… websites, die unsere marketing fritzen zu recherchzwecken anhäufen die Bilder herausholen. Bisher mach ich das manuell, aber ich werd verrückt damit. Daher will ich den unten angefügten code verwenden. ABER es fehlen noch zwei ZUSATZBEDINGUNGEN, denn auf praktisch allen sites sind kleine logos, banner oder so, daher muss ich eine mindestgröße z.b. 100 kb und mindestabmessungen z.B. 100x100 einbauen, von denen ich nicht weiss wie man die in vba formuliert. Hat da jemand eine gute idee für mich?
Option Explicit
Sub grafik_transfer
Dim objFSO As FileSystemObject
Dim objSourceFolder1 As Folder, objSourceFolder2 As Folder
Dim objDestFolder As Folder
Dim objFile As File
Dim strSF1 As String
Dim strDestFolder As String
Application.ScreenUpdating = False
Application.EnableEvents = False
strSF1 = fncBrowseForFolder
strDestFolder = recherchen\Bilder
Set objFSO = New FileSystemObject
Set objFolder = objFSO.GetFolderstrSF1
If > 0 Then GoTo NoFolders
For Each objSourceFolder2 In objSourceFolder1
For Each objFile In objSourceFolder2.Files
If InStr1, objFile.Name, .jpg InStr1, objFile.Name, .gif InStr1, objFile.Name, .png Then
objFile.Copy strDestFolder & \ & objFile.Name
End If
Next objFile
Next objSourceFolder2
Set objFile = Nothing: Set objFSO = Nothing: Set objSourceFolder1 = Nothing: Set objSourceFolder2 = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
NoFolders:
If objSourceFolder1.Files.Count > 0 Then
For Each objFile In objSourceFolder2.Files
If InStr1, objFile.Name, .jpg InStr1, objFile.Name, .gif InStr1, objFile.Name, .png Then
objFile.Copy strDestFolder & \ & objFile.Name
End If
Next objFile
Set objFile = Nothing: Set objFSO = Nothing: Set objSourceFolder1 = Nothing: Set objSourceFolder2 = Nothing
Application.ScreenUpdating = True 'turn screenupdating back on
Application.EnableEvents = True 'turn events back on
Exit Sub
End If
Set objFile = Nothing: Set objFSO = Nothing: Set objSourceFolder1 = Nothing: Set objSourceFolder2 = Nothing
Application.ScreenUpdating = True 'turn screenupdating back on
Application.EnableEvents = True 'turn events back on
End Sub
Private Function fncBrowseForFolderOptional ByVal defaultPath = recherchen As String
Dim objFlderItem As Object, objShell As Object, objFlder As Object

Set objShell = CreateObjectShell.Application
Set objFlder = objShell.BrowseForFolder0&, Ordner auswählen…, 0&, defaultPath

If objFlder Is Nothing Then GoTo ErrExit

Set objFlderItem = objFlder.Self
fncBrowseForFolder = objFlderItem.Path
ErrExit:
Set objShell = Nothing
Set objFlder = Nothing
Set objFlderItem = Nothing
End Function

Hallo,

Leider kann ich hier nicht helfen. Ich kenne mich lediglich in Excel VBA gut aus…

Vielen Dank

Christian Philippi

Da kann ich eider nicht helfen

Guten Morgen,

mit objFile.ExtendedProperty(„Dimensions“) bekommst Du die Pixel, mit objFile.ExtendedProperty(„Size“) die Größe in Byte.

Beste Grüße
Michael

Hallo,

wenn man nicht weiss, wie es in VBA geht ist es immer hilfreich ein Makro aufzuzeichnen, bei dem man genau das macht, was man sucht,

hat mir schon häufig geholfen,

Gruss

Hallo LostLeader,

wieso das Rad neu erfinden? Dafür gibt es gute Software: http://www.google.de/#hl=de&tbo=d&biw=1440&bih=761&s…

HTTrack müßte für diese Zwecke eigentlich funktionieren.

Falls weiter selbst programmiert werden soll, dann bitte entsprechende Rückantwort.

Gruß
Harry

Sorry, aber das ist nicht mein Gebiet.

mfg

… websites, die unsere marketing fritzen zu recherchzwecken
anhäufen die Bilder herausholen. Bisher mach ich das manuell,
aber ich werd verrückt damit. Daher will ich den unten
angefügten code verwenden. ABER es fehlen noch zwei
ZUSATZBEDINGUNGEN, denn auf praktisch allen sites sind kleine
logos, banner oder so, daher muss ich eine mindestgröße z.b.
100 kb und mindestabmessungen z.B. 100x100 einbauen, von
denen ich nicht weiss wie man die in vba formuliert. Hat da
jemand eine gute idee für mich?

tut mir leid, kann nicht helfen
Gruß
Brandis

Hallo LostLeader,

anhäufen die Bilder herausholen. Bisher mach ich das manuell,
aber ich werd verrückt damit. Daher will ich den unten
angefügten code verwenden. ABER es fehlen noch zwei
ZUSATZBEDINGUNGEN, denn auf praktisch allen sites sind kleine
logos, banner oder so, daher muss ich eine mindestgröße z.b.
100 kb und mindestabmessungen z.B. 100x100 einbauen, von
denen ich nicht weiss wie man die in vba formuliert. Hat da
jemand eine gute idee für mich?

ich verwende VBA für kleinere Aufgaben in Excel. Deine Anfrage geht über meinen Horizont hinaus.
Aber hier kannst Du mal schauen:
http://www.ms-office-forum.net/forum/showthread.php?..
MfG MwieMichel

Hallo LostLeader,

zwei Ansätze. Zuerst mal speichern viele Webseitenmacher die zugehörigen Bilder mit aussagefähigen Namen, etwa „button_120x60.gif“. Eine intensivere „Absuche“ vulgo Filtern der als Bilder identifizierten Tags könnte helfen.
Ansonsten bleibt eh nur das explizite Laden und hinterher filtern - das könnte sich als schneller erweisen.
So einen „Hinterher-Filter“ baust Du recht einfach zusammen, indem Du die ganzen Namen sammelst und jeweils in eine Excel-Zelle speicherst, um dann eine Bewertung vorzunehmen. Das kann auch helfen bei der späteren „Rückwärtszuweisung“ eines Bildes auf die Website (Quelle in gleicher Zeile mit abspeichern).

Nur Dateigröße geht mit dem Explorer schneller, da weißt Du dann aber nicht mehr woher das Bild kam.

Mit freundlichem Gruße,

Matthias

Hallo LostLeader.
Natürlich, das Ganze nennt sich Windows API und heisst GetFilesize oder exGetFilesize.

Private Function GetFileSize(ByVal SumInvNum As String) as Double
Dim fs, f As Object

Set fs = CreateObject(„Scripting.FileSystemObject“)
Set f = fs.GetFile(‚Path‘)

GetFileSize = f.Size

Set fs = Nothing
Set f = Nothing

End Function

Grüsse Sebastian