Brauche dringend Hilfe in Excel Makros

Hallo allerseits,

ich hoffe ihr könnt mir helfen. Meine Excel-Makro Kenntnisse gehen gegen null und ich soll nun was programmieren. Habe folgendes Problem / Fragestellung.

Ich möchte gerne aus verschiedenen Unterordnern eine Text-File automatisch lesen und die darin enthaltenen Messdaten in Excel-Mappen kopieren/ablegen. Die Unterordner haben den gleichen Anfangsnamen enden aber immer unterschiedlich Bsp.:

- C:\...\0123_Sep_24_06_59_40\Test.txt
- C:\...\0123_Sep_24_07_01_43\Test.txt
- C:\...\0123_Sep_25_07_08_28\Test.txt
- C:\...\0123_Okt_01_07_08_22\Test.txt

In den Text-Files sind untereinander Messwerte aufgelistet, die ich gerne in die Zelle A2 einfügen will. Für jeden Unterordner sollte jeweils eine Excel-Mappe mit gleichem Namen angelegt werden.

Ich hoffe ihr könnt mir weiterhelfen. Falls ihr mehr Infos benötigt, einfach schreiben.

Gruß

Stefan

Please also mark the comments that contributed to the solution of the article

Content-Key: 286264

Url: https://administrator.de/contentid/286264

Printed on: April 23, 2024 at 09:04 o'clock

4 Comments

Latest comment

Ich würde da mal nachfragen falls hier keinen nen Tipp hat.
http://ms-office-forum.net/forum/

Moin,

Zitat von @StefanH:
ich hoffe ihr könnt mir helfen. Meine Excel-Makro Kenntnisse gehen gegen null und ich soll nun was programmieren. Habe folgendes Problem / Fragestellung.

hmmm... weiß derjenige der dich damit beauftragt hat das du keinen Schimmer hast, klingt ein bißchen nach "Klar kann ich, mach ich für dich ..."
Und dann noch dringend ??

Ich möchte gerne aus verschiedenen Unterordnern eine Text-File automatisch lesen und die darin enthaltenen Messdaten in Excel-Mappen kopieren/ablegen. Die Unterordner haben den gleichen Anfangsnamen enden aber immer unterschiedlich Bsp.:

Na dann, hier was zum spielen.

Sub Import()
    Const QUELLE = "C:\Oberordner"  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    
    For Each folder In fso.GetFolder(QUELLE).SubFolders
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
        ws.Name = folder.Name
        For Each file In folder.Files
            If LCase(fso.GetExtensionName(file.Name)) = "txt" Then  
                With ws.QueryTables.Add(Connection:="TEXT;" & file.Path, Destination:=ws.Range("A2"))  
                    .Name = "import"  
                    .FieldNames = True
                    .AdjustColumnWidth = True
                    .RefreshPeriod = 0
                    .TextFilePlatform = 1252
                    .TextFileDecimalSeparator = ","  
                    .TextFileStartRow = 1
                    .TextFileParseType = xlDelimited
                    .TextFileTextQualifier = xlTextQualifierDoubleQuote
                    .Refresh BackgroundQuery:=False
                    .Delete
                End With
            End If
        Next
    Next
End Sub