Excel VBA ouvrir le dossier et obtenir les infos GPS (Exif) de chacun des fichiers

Guidé par Jzz et David sur un autre post, j'ai découvert un VBA userform et de modules qui peuvent être importés à l'Accès DB ou Excel qui va vous demander de sélectionner un fichier et il va afficher les informations EXIF externes info de ce fichier en particulier GPS Longitude, la Latitude et l'Altitude.

Ma question est comment puis-je convertir cette façon qu'elle s'ouvre un dossier à la place et récupère les infos GPS sur chacun des fichiers dans ce dossier. Je sais que cela peut besoin d'une boucle sur le contenu d'un dossier mais je n'ai aucune idée de comment faire pour convertir ce. Veuillez voir le fichier joint et ouvrir l'Accès DB. J'étais seulement capable de les transférer vers Excel mais le code a été écrit dans de trop nombreux appels supplémentaires et des fonctions que je ne pouvais pas comprendre tout de suite. Il serait agréable d'être en mesure de le modifier et de le rendre plus court.

EXIFReader

Sarah

MODIFIER Merci à David, voici ma version modifiée:

Sub OpenFromFolder()

On Error GoTo ExifError

    Dim strDump As String
    'Dim fso As Scripting.FileSystemObject
    'Dim fldr As Scripting.Folder
    'Dim file As Scripting.file

    Set fso = CreateObject("scripting.filesystemobject")
    Set fldr = fso.GetFolder("C:/Users/JayP/Downloads/Camera Uploads/Pics")  '#### Modify this to your folder location

    For Each file In fldr.Files
    '## ONLY USE JPG EXTENSION FILES!!
    Select Case UCase(Right(file.Name, 3))
        Case "JPG"
            With GPSExifReader.OpenFile(file.Path)
                currrow = Sheet1.UsedRange.Rows.Count + 1
                Sheet1.Range("A" & currrow).Value = "GPSLatitudeDecimal:        " & .GPSLatitudeDecimal
                Sheet1.Range("B" & currrow).Value = "GPSLongitudeDecimal:       " & .GPSLongitudeDecimal
                Sheet1.Range("C" & currrow).Value = "GPSAltitudeDecimal:        " & .GPSAltitudeDecimal
           End With
       End Select
NextFile:
    Next
    Exit Sub

ExifError:
    MsgBox "An error has occurred with file: " & file.Name & vbCrLf & vbCrLf & Err.Description
    Err.Clear
    Resume NextFile
End Sub

OriginalL'auteur user3682866 | 2014-06-04

  1. 3

    Qui est assez sophistiqué code -- écrit par Wayne Phillips qui est certifié Microsoft MVP. Alors qu'il pourrait être sympa pour rendre le code plus lisible, je soupçonne que c'est déjà très optimisé.

    Je vous poste cette réponse parce que c'est une question intéressante/application, normalement, je devrais dire "Montrez-moi ce que vous avez essayé jusqu'à présent", mais compte tenu de la relative complexité de Wayne code, je vais déroger à cette exigence. CEPENDANT, l'inconvénient supplémentaire est que je ne vais pas répondre à une douzaine de questions de suivi sur ce code pour enseigner comment utiliser VBA. Ce code a été testé et il fonctionne.

    Il y a un solde non utilisé de l'appel de fonction qui vous permet d'ouvrir à partir d'un chemin, nous allons l'utiliser dans une boucle sur tous les fichiers dans un dossier spécifié.

    Function OpenFile(ByVal FilePath As String) As GPSExifProperties
    Set OpenFile = m_ClassFactory.OpenFile(FilePath)
End Function

    1. Importer les Modules de Classe de Wayne de code dans votre classeur de VBProject (je pense que vous l'avez déjà fait).

    2. Créer un nouveau sous-programme comme celui-ci, dans un module de code. 

    Sub OpenFromFolder()
On Error GoTo ExifError
Dim strDump As String
'## REQUIRES REFERENCE TO MICROSOFT SCRIPTING RUNTIME 
Dim fso As Scripting.FileSystemObject
Dim fldr As Scripting.Folder
Dim file As Scripting.file
Set fso = CreateObject("scripting.filesystemobject")
Set fldr = fso.GetFolder("C:/users/david_zemens/desktop/")  '#### Modify this to your folder location
For Each file In fldr.Files
'## ONLY USE JPG EXTENSION FILES!!
Select Case UCase(Right(file.Name, 3))
Case "JPG"
With GPSExifReader.OpenFile(file.Path)
strDump = strDump & "FilePath:                  " & .FilePath & vbCrLf
strDump = strDump & "DateTimeOriginal:          " & .DateTimeOriginal & vbCrLf
strDump = strDump & "GPSVersionID:              " & .GPSVersionID & vbCrLf
strDump = strDump & "GPSLatitudeDecimal:        " & .GPSLatitudeDecimal & vbCrLf
strDump = strDump & "GPSLongitudeDecimal:       " & .GPSLongitudeDecimal & vbCrLf
strDump = strDump & "GPSAltitudeDecimal:        " & .GPSAltitudeDecimal & vbCrLf
strDump = strDump & "GPSSatellites:             " & .GPSSatellites & vbCrLf
strDump = strDump & "GPSStatus:                 " & .GPSStatus & vbCrLf
strDump = strDump & "GPSMeasureMode:            " & .GPSMeasureMode & vbCrLf
strDump = strDump & "GPSDOPDecimal:             " & .GPSDOPDecimal & vbCrLf
strDump = strDump & "GPSSpeedRef:               " & .GPSSpeedRef & vbCrLf
strDump = strDump & "GPSSpeedDecimal:           " & .GPSSpeedDecimal & vbCrLf
strDump = strDump & "GPSTrackRef:               " & .GPSTrackRef & vbCrLf
strDump = strDump & "GPSTrackDecimal:           " & .GPSTrackDecimal & vbCrLf
strDump = strDump & "GPSImgDirectionRef:        " & .GPSImgDirectionRef & vbCrLf
strDump = strDump & "GPSImgDirectionDecimal:    " & .GPSImgDirectionDecimal & vbCrLf
strDump = strDump & "GPSMapDatum:               " & .GPSMapDatum & vbCrLf
strDump = strDump & "GPSDestLatitudeDecimal:    " & .GPSDestLatitudeDecimal & vbCrLf
strDump = strDump & "GPSDestLongitudeDecimal:   " & .GPSDestLongitudeDecimal & vbCrLf
strDump = strDump & "GPSDestBearingRef:         " & .GPSDestBearingRef & vbCrLf
strDump = strDump & "GPSDestBearingDecimal:     " & .GPSDestBearingDecimal & vbCrLf
strDump = strDump & "GPSDestDistanceRef:        " & .GPSDestDistanceRef & vbCrLf
strDump = strDump & "GPSDestDistanceDecimal:    " & .GPSDestDistanceDecimal & vbCrLf
strDump = strDump & "GPSProcessingMethod:       " & .GPSProcessingMethod & vbCrLf
strDump = strDump & "GPSAreaInformation:        " & .GPSAreaInformation & vbCrLf
strDump = strDump & "GPSDateStamp:              " & .GPSDateStamp & vbCrLf
strDump = strDump & "GPSTimeStamp:              " & .GPSTimeStamp & vbCrLf
strDump = strDump & "GPSDifferentialCorrection: " & .GPSDifferentialCorrection & vbCrLf
Debug.Print strDump   '## Modify this to print the results wherever you want them...
End With
End Select
NextFile:
Next
Exit Sub
ExifError:
MsgBox "An error has occurred with file: " & file.Name & vbCrLf & vbCrLf & Err.Description
Err.Clear
Resume NextFile
End Sub

    Vous devez modifier ce:

    Set fldr = fso.GetFolder("C:/users/david_zemens/desktop/")

    Et aussi cela. Je suppose que vous savez déjà comment mettre les données dans une feuille de calcul ou l'afficher dans un formulaire, etc. Cette ligne imprime uniquement à la console par la fenêtre exécution de VBA, il ne pourra pas écrire sur une feuille de calcul/etc. à moins de le modifier pour le faire. Qui ne fait pas partie de la question, donc je vais laisser cela à vous de travailler 🙂

    Debug.Print strDump

    REMARQUE: j'ai enlevé certaines variables d'objet que vous n'aurez pas dans Excel, et ajout de nouvelles variables pour faire le Dossier/Fichiers itération. J'ai mis une simple erreur de manipulation afin de vous informer des erreurs (msgbox), et de reprendre le fichier suivant. Dans mes tests, la seule erreur que j'ai eu était certains fichiers n'ont pas de données EXIF.

    Merci David, ça a fonctionné. J'ai ajouté ma version modifiée sur le dessus. J'ai eu à commenter les 3 déclarations bien, ils me donnent des erreurs, mais après qu'ils semblent être au travail droit
    Ahhh droit que vous pourriez faire une de deux choses: 1) Déclarer chaque Object, ou 2) ajouter une référence à la bibliothèque Microsoft Scripting Runtime et les déclarations As Scripting.FileSystemObject, etc., devrait fonctionner.
    Déclaration d'un objet semble plus facile.:) Maintenant, je suis à la dernière étape de ce projet, qui est de savoir comment le code VBA pour traduire automatiquement les coordonnées dans l'adresse complète (Rue, Ville, État, code Postal). J'ai vu un pour PHP en utilisant GoogleAPI mais je vais poster une autre qustion pour ce que pour éviter hyjacking 🙂
    Tirer récemment, j'ai fait le contraire: j'ai utilisé l'API Google Maps pour get le Lat/Lon à partir d'une adresse ou un nom de ville. C'était assez compliqué à l'aide d'un XMLHTTPRequest pour communiquer avec l'API, et DOM pour analyser les résultats. Je vais garder un œil sur votre Q si j'ai le temps, je peux sans doute vous aider.

    OriginalL'auteur David Zemens