Selektiver Datei import über VPN Server

  • Excel

Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von DavDav.

    Selektiver Datei import über VPN Server

    Hallo liebe Community
    Gleich vornweg ich hab weder Ahnung von programmieren noch von VBA. Trotzdem würde ich würde aber gerne ein Makro haben welches mir Datenauswertung im Rahmen meiner Masterarbeit erleichtern würde.
    Folgende Situation:Meine Programm läuft auf einem Server auf den ich mit WinSCP und CiscoAnyConnect/VPN zugreife. Dort werden Daten in folgender Weise abgespeichert: " /.../Molekülname(zb Ethan)/md_runs/1 " Die Zahl eins gibt den Ersten Versuch an und das geht bis 20 hoch.in jedem dieser 20 Ordner liegt eine datei "msd.xvg" (Beispiel im Anhang hab sie in .txt umwandeln müssen aber in Notepad++ passen Zeilen etc noch wie in der .xvg datei ) die immer ab der selben Zeile die Zeit gefolgt von der MSD angibt. Ich will nun die Spalte "MSD" aus den 20 Dateien importieren in ein Excel Sheet überführen um dann noch 2-3 kurze rechnen Schritte damit durchzuführen (Mittelwert Bilden, Einheiten umrechnen...).
    Am besten wäre es, wenn ich nur das excel sheet öffnen müsste, den einen Molekülordner anklicken müsste und dann sämtliche Werte in eine vorgefertigte Maske übertragen werden (die nötigen Umformungen sind ja für alle Versuche die gleichen) Das importieren der .xvg Dateien funktioniert mit dem Code aus dieser Seite (VBA Code to import multiple text files from subfolders into a single - Microsoft Community) Allerdings fügt dieser Code sämtliche Dateien untereinander und ich will ja die Einträge der rechten Spalte ab Zeile 20.
    Danke für jede Hilfe und falls mir jemand nen funktionierendes Makro schreiben kann würde ich auch ne kleine Spende verschicken :]
    Dateien

    • msd.txt

      (4,08 kB, 139 mal heruntergeladen, zuletzt: )

    DavDav schrieb:

    Allerdings fügt dieser Code sämtliche Dateien untereinander und ich will ja die Einträge der rechten Spalte ab Zeile 20

    Kannst du deinen Code mal hier veröffentlichen?
    Den abzuändern für deine Ansprüche scheint mir kein allzu großes Problem zu sein.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Ach verdammt den wollte ich natürlich anhängen, danke für die schnelle Antwort

    Hier auch noch der Dropbox Link zu der ExcelDatei in der ich das mal probiert hab (da sieht man den code vllt etwas übersichtlicher)

    dropbox.com/s/wz8da2bfn10sgrw/VBAtests.xlsm?dl=0

    Quellcode

    1. Sub Demo()
    2. Dim fso As Object 'FileSystemObject
    3. Dim fldStart As Object 'Folder
    4. Dim fld As Object 'Folder
    5. Dim fl As Object 'File
    6. Dim Mask As String
    8. Application.ScreenUpdating = False
    9. Dim newWS As Worksheet
    11. Set newWS = Sheets.Add(before:=Sheets(1))
    13. Set fso = CreateObject("scripting.FileSystemObject") ' late binding
    14. 'Set fso = New FileSystemObject 'or use early binding (also replace Object types)
    16. Set fldStart = fso.GetFolder("C:\Folder1") ' <-- use your FileDialog code here
    17. Mask = "*.xvg"
    18. 'Debug.Print fldStart.Path & "\"
    19. ListFiles fldStart, Mask
    20. For Each fld In fldStart.SubFolders
    21. ListFiles fld, Mask
    22. ListFolders fld, Mask
    23. Next
    26. Dim myWB As Workbook, WB As Workbook
    27. Set myWB = ThisWorkbook
    28. Dim L As Long, t As Long, i As Long
    29. L = myWB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
    30. t = 1
    31. For i = 1 To L
    32. Workbooks.OpenText Filename:=myWB.Sheets(1).Cells(i, 1).Value, DataType:=xlDelimited, Tab:=True
    33. Set WB = ActiveWorkbook
    34. WB.Sheets(1).UsedRange.Copy newWS.Cells(t, 2)
    35. t = myWB.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row + 1
    36. WB.Close False
    37. Next
    38. myWB.Sheets(1).Columns(1).Delete
    39. Application.ScreenUpdating = True
    40. End Sub
    44. Sub ListFolders(fldStart As Object, Mask As String)
    45. Dim fld As Object 'Folder
    46. For Each fld In fldStart.SubFolders
    47. 'Debug.Print fld.Path & "\"
    48. ListFiles fld, Mask
    49. ListFolders fld, Mask
    50. Next
    51. End Sub
    55. Sub ListFiles(fld As Object, Mask As String)
    56. Dim t As Long
    57. Dim fl As Object 'File
    58. For Each fl In fld.Files
    59. If fl.Name Like Mask Then
    60. t = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
    61. 'Debug.Print fld.Path & "\" & fl.Name
    62. If Sheets(1).Cells(1, 1) = "" Then
    63. Sheets(1).Cells(1, 1) = fld.Path & "\" & fl.Name
    64. Else
    65. Sheets(1).Cells(t, 1) = fld.Path & "\" & fl.Name
    66. End If
    67. End If
    68. Next
    69. End Sub

Facebook
Telefonspende