Extrayez une seule ligne de données à partir de nombreux fichiers texte et importez-les dans Excel - excel, excel-vba, vba

J'ai des centaines de fichiers texte dans un dossier et jebesoin d'extraire une seule ligne de chacun et de mettre les informations dans Excel. Les fichiers texte contiennent toutes les métadonnées pour des photographies individuelles et je dois extraire uniquement les coordonnées GPS.

J'ai parcouru divers autres sujets similaires, par exemple: extraire les données de plusieurs fichiers texte d'un dossier dans une feuille de calcul Excel

et:

http://www.mrexcel.com/forum/excel-questions/531515-visual-basic-applications-retrieve-data-text-file.html (désolé, pas stackoverflow!)

et beaucoup d’autres, mais je ne peux tout à fait le faire fonctionner. Je suis proche mais pas tout à fait là.

Les données dans chacun des fichiers texte sont définies comme suit:

...

---- Composite ----
Aperture                        : 3.8
GPS Altitude                    : 37.2 m Above Sea Level
GPS Date/Time                   : 2014:05:15 10:30:55.7Z
GPS Latitude                    : 50 deg 7" 33.40" N
GPS Longitude                   : 5 deg 30" 4.06" W
GPS Position                    : 50 deg 7" 33.40" N, 5 deg 30" 4.06" W
Image Size                      : 4608x3456

...

J'ai écrit le code suivant:

Sub ExtractGPS()
Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, posGPS As String

MyFolder = "C:UsersDesktopTest"
MyFile = Dir(MyFolder & "*.txt")

Do While MyFile <> ""
Open (MyFolder & MyFile) For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop

Close #1
MyFile = Dir()
posGPS = InStr(text, "GPS Position")
nextrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).row + 1
Sheet1.Cells(nextrow, "A").Value = Mid(text, posGPS + 33, 37)
Loop
End Sub

Il semble ouvrir chacun des fichiers texte etParcourez-les mais ne faites qu'extraire les coordonnées GPS du premier fichier et mettez-les à plusieurs reprises dans Excel. Je me retrouve donc avec des centaines de lignes remplies des mêmes données - les coordonnées GPS du premier fichier du dossier.

Si quelqu'un pouvait m'aider à finir ce dernier sujet, ce serait grandement apprécié!

Merci

Réponses:

Vous devez réinitialiser votre text sinon, le contenu du deuxième fichier est ajouté et non remplacé. La recherche recherche toujours les premières données GPS et arrête la recherche:

Sub ExtractGPS()
Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, posGPS As String

MyFolder = "C:TempTest"
MyFile = Dir(MyFolder & "*.txt")

Do While MyFile <> ""
Open (MyFolder & MyFile) For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline "second loop text is already stored -> see reset text
Loop
Close #1
MyFile = Dir()
Debug.Print text
posGPS = InStr(text, "GPS Position")
nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
ActiveSheet.Cells(nextrow, "A").Value = Mid(text, posGPS + 33, 37)
text = "" "reset text
Loop
End Sub