Option Explicit On Imports System.IO Module Modul_SB_PictureTagger Structure Mark Dim Position As String Dim ID As String Dim Description As String End Structure 'Mark Structure Place Dim Adresse Dim Description Dim GPS End Structure Structure TaggedIMG Dim ID As Long Dim Title As String Dim Description As String Dim Time As String Dim Mark() As Mark Dim Image As Image Dim Path As String Dim Place As Place End Structure 'TaggedIMG 'Methoden Index: '1.LoadPicture ' Parameter: "-SupportedFormats-" -> Array of Supported Formats; ' Parameter: File Pfad -> Picture ##in Work!## '2.DirReadPhotos ' Parameter: Ordner Pfad; Return: Array von Pfaden der Bilddateien des Ordners '################################################################################################################### '############### 1.LoadPicture ##################################################################################### '################################################################################################################### Public Function LoadPicture(ByVal sPath As String) As Object 'Deklariere Dim aPhotoFormats(0) As String 'Array Enthält die Unsterstützten Photoformate '###Statische Einstellungen### 'Die Untestützten Formate einstellen ReDim Preserve aPhotoFormats(5) aPhotoFormats(0) = ".jpg" aPhotoFormats(1) = ".bmp" aPhotoFormats(2) = ".gif" aPhotoFormats(3) = ".png" aPhotoFormats(4) = ".jp2" aPhotoFormats(5) = ".tif" 'Entscheide ob Rückgabe des Arrays für die FormatUnterstützung 'Oder das Laden des Bildes aus der angegebenen Quelle If sPath = "-SupportedFormats-" Then LoadPicture = aPhotoFormats ElseIf (File.Exists(sPath) = True) Then 'BildLadeFunktion 'Main Work############################################### Dim iPicture As New TaggedIMG 'Testen ob Vormat unterstüzt! iPicture.Path = sPath iPicture.Image = Image.FromFile(sPath) 'Wird hier später mit Tagg Bestückt! LoadPicture = iPicture 'Main Work Ende########################################## Else MsgBox("Can't load Picture") LoadPicture = "" End If End Function 'LoadPicture '################################################################################################################### '############### 2.DirReadPhotos ################################################################################### '################################################################################################################### Public Function DirReadPhotos(ByVal sPath As String) As Object 'Parameter: Ordner Pfad 'Return: Array von Pfaden der Bilddateien des Ordners Dim aPhotos(0) As String Dim i As Long Dim sPhotoFormat As String Dim aPhotoFormats(0) As String 'Array Enthält die Unsterstützten Photoformate 'Lade Unterstüzte Formate: aPhotoFormats = LoadPicture("-SupportedFormats-") Try 'Deklarieren Dim aFiles As String() = Directory.GetFiles(sPath) ' Try verwenden!! <---- 'Überprüfen auf existenz des Ordners 'Ja: Weiter 'Nein: MsgBox("Error: Der Pfad existiert Nicht!") If Directory.Exists(sPath) = True Then 'Speichere Pfad in Array aPhotos 'Wenn das File die Dateiendungen aus Array aPhotoFormats besitzt Dim nCount As Long = 0 If aFiles(0) <> "" Then aPhotos(0) = "" For i = 0 To UBound(aFiles) For Each sPhotoFormat In aPhotoFormats If IO.Path.GetExtension(aFiles(i)) = sPhotoFormat Then If nCount > UBound(aPhotos) Then ReDim Preserve aPhotos(nCount) End If aPhotos(nCount) = aFiles(i) nCount = nCount + 1 End If Next sPhotoFormat Next i Else aPhotos(0) = "" End If 'Array Nach Dateinahmen Sortieren Array.Sort(aPhotos) Else MsgBox("Error: Der Pfad existiert Nicht!") aPhotos(0) = "" End If DirReadPhotos = aPhotos Catch ex As Exception MsgBox(ex.Message) aPhotos(0) = "" DirReadPhotos = aPhotos End Try End Function 'DirReadPhotos 'Vor VBA AND VB without .Net '### with .Net: Imports System.IO; Directory.Exists(Path)#### 'Private Function FileExists(ByVal FileName As String) As Boolean ' On Error Resume Next ' FileExists = Not CBool(GetAttr(FileName) And (vbDirectory Or vbVolume)) ' On Error GoTo 0 'End Function '### with .Net: Imports System.IO; File.Exists(Path)#### 'Private Function DirExists(ByVal DirectoryName As String) As Boolean ' On Error Resume Next ' DirExists = CBool(GetAttr(DirectoryName) And vbDirectory) ' On Error GoTo 0 'End Function End Module