Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Code für Einlesen aus ganzen Ordner abändern

Betrifft: Code für Einlesen aus ganzen Ordner abändern von: Hornung
Geschrieben am: 03.07.2015 17:45:28

Hallo zusammen,

ich nutze folgenden Code zur Umwandlung meiner .csv-Dateien, so dass jeweils nach einem Komma eine neue Spalte entsteht. Das klappt auch gut.

Sub einlesen()
   
With Application
.DecimalSeparator = "."
.ThousandsSeparator = ""
   
     Dim wb As Workbook, wks As Worksheet, wbAktiv As Workbook, wksAktiv As Worksheet
     Dim rngZelle As Range
     Dim strVerzeichnis As String
     Dim Dateiname As Variant, DateinameTXT As String
    
    
       ChDrive "E"
       ChDir "E:\Test\...\Auswertung\"
       Dateiname = Application.GetOpenFilename(FileFilter:="CSV (*.csv), *.csv")
       If Dateiname = False Then Exit Sub
       strVerzeichnis = VBA.CurDir
       Set wbAktiv = ActiveWorkbook
       Set wksAktiv = ActiveSheet
       Set rngZelle = Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Offset(0, 0)
       Application.ScreenUpdating = False
      
       
       VBA.FileCopy Source:=Dateiname, Destination:=Left(Dateiname, Len(Dateiname) - 3) & "txt"  _
_
   
       DateinameTXT = Left(Dateiname, Len(Dateiname) - 3) & "txt"
       
       Application.Workbooks.OpenText Filename:=DateinameTXT, Origin:=xlWindows, _
             StartRow:=1, _
             DataType:=xlDelimited, ConsecutiveDelimiter:=False, _
             Tab:=False, _
             Semicolon:=False, _
             Comma:=True, _
             Space:=False, _
             Other:=False
       Set wb = ActiveWorkbook
       
       wb.Sheets(1).UsedRange.Copy
       rngZelle.PasteSpecial Paste:=xlPasteValues
       
       
       Application.CutCopyMode = False
       Set rngZelle = rngZelle.Offset(wb.Sheets(1).UsedRange.Rows.Count, 0)
       wb.Close savechanges:=False
       
       VBA.Kill (DateinameTXT)
       Application.ScreenUpdating = True
      
   
   ActiveSheet.Copy
   
      
   fil = Application.GetSaveAsFilename(, FileFilter:="Excel Arbeitsmappe (*.xls),*.xls")
   If fil = False Then Exit Sub
   ActiveWorkbook.SaveAs Filename:=fil, FileFormat:=xlExcel8
   
   ActiveWorkbook.Close (True)
   Worksheets("Tabelle1").Cells.Clear
   Range("A1").Select
   
   
   
  End With
   
End Sub



Da ich jedoch immer mehrere Dateien auf einmal umwandeln muss, wäre es super, wenn ich (manuell) einen Ordner auswählen könnte (z.B. C:\Test\Rohdateien) und automatisch alle Dateien, die sich darin befinden entsprechend umgewandelt werden und anschließend unter usprünglichem Namen, aber in einem anderen Ordner (z.B. C:\Test\eingelesen) abgespeichert werden würden.

Kann mir damit vielleicht jemand helfen? :)

Das wäre super!

Viele Grüße
Marcel

  

Betrifft: AW: Code für Einlesen aus ganzen Ordner abändern von: Taro
Geschrieben am: 03.07.2015 18:12:21

Hallo,

sind es zu viele Dateien für den Standard-Import, da kannst du ja das Trennzeichen auch umstellen?

Gruß
Taro


  

Betrifft: AW: Code für Einlesen aus ganzen Ordner abändern von: Hornung
Geschrieben am: 03.07.2015 18:57:31

Hallo,

es sind nicht so viele Dateien, weniger als 10 in der Regel.
Aber ich verstehe deine Frage nicht so ganz? Was meinst du genau?:)

Viele Grüße
Marcel


  

Betrifft: AW: Code für Einlesen aus ganzen Ordner abändern von: Taro
Geschrieben am: 03.07.2015 19:06:04

Naja.
So wie ich deinen Quellcode lese macht der nichts anderes als *.csv Dateien importieren. Und du stellst beim Import das Trennzeichen von Semikolon auf Komma um. Dann kopierst du die importierte Range in eine neue Excel-Datei.

Ich frage mich warum du das über den Quellcode machst. Excel bietet ja die Möglichkeit Text-Dateien zu importieren und da kannst du das Trennzeichen auch einstellen.
Ich kann es verstehen wenn es viele Dateien sind und die in kurzen Abständen aktualisiert werden. Aber für wenige Dateien würde ich den Import von Excel verwenden.


  

Betrifft: AW: Code für Einlesen aus ganzen Ordner abändern von: Hornung
Geschrieben am: 04.07.2015 10:38:59

Danke, das ist ein guter Hinweis. Ich wusste garnichts von der Funktion.
Da sich aber an das Einlesen noch ein größere "Auswerteprozess" über weitere Makros anschließt, würde ich das Umwandeln wie oben beschrieben auch gerne automatisiert über ein Makro starten.
So könnte ich eben den ganzen Analyseprozess mit einem Klick starten und muss nicht erst jedes mal 6-10 Dateien "von Hand" umwandeln.
Kannst du/jemand mir dabei helfen den Code entsprechend abzuändern?

Danke schon einmal und viele Grüße
Marcel


  

Betrifft: AW: Code für Einlesen aus ganzen Ordner abändern von: Thomas
Geschrieben am: 04.07.2015 12:53:16

Hallo probiere mal dies.

Achtung Ich bin kein Excelprofie. Hatte vor kurzem ein ähnliches Problem da hatt mir ein sehr guter
VBA schreiber aus dem Forum den hintern gerettet.

Vieleicht kannst Du auch damit was anfangen.


liebe grüsse Thomas


Option Explicit
'Quelle: http://www. _
herber.de/forum/archiv/1064to1068/t1064122.htm#1064890

'Modifiziert: Franz Sielck 2010-08-07

Public lCount As Long, arrFiles() As String

Sub ListFilesInFolder(ByVal SourceFolderName As String, _
    Optional DateiFormat As String = "*.*", _
    Optional IncludeSubfolders As Boolean = False, _
    Optional FolderName As Boolean = False)
  '1.Parameter Ordner, wo soll gesucht werden?
  '2.Parameter Datei,* als Platzhalter verwenden,Optional leer ist alle
  '3.Parameter mit Unterordner = True, Optional False ist ohne
  '4.Parameter kompl. Pfad ausgeben = True, Optional nur Dateiname = False
  'Erstellt gemäß Suchkriterien ein Array mit den Dateinamen - optional inkl. Pfad
  Dim FSO As Object, SourceFolder As Object, SubFolder As Object
  Dim FileItem
  
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set SourceFolder = FSO.GetFolder(SourceFolderName)
        
  On Error GoTo Err_Zugriff: 'sollte Ordner geschützt sein

    For Each FileItem In SourceFolder.Files
        If LCase(FileItem.Name) Like LCase(DateiFormat) Then
          lCount = lCount + 1
          ReDim Preserve arrFiles(1 To lCount)
          arrFiles(lCount) = IIf(FolderName, FileItem, FileItem.Name)
        End If
    Next FileItem
    
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, DateiFormat, IncludeSubfolders, FolderName
        Next SubFolder
    End If

Err_Zugriff:
    Set FileItem = Nothing: Set SourceFolder = Nothing: Set FSO = Nothing
End Sub
Sub csv_untereinander()
'(C) Ramses
'Liest alle CSV-Dateien in einem Verzeichnis ein
    Dim Datei As Variant, freeRow As Long
    Dim Qe As Integer
    Dim PFAD As String
    
    Qe = MsgBox("Zum Import muss die aktuelle Tabelle leer sein," & vbCrLf & _
        "bzw. alle Daten der aktuellen Tabelle: "" " & ActiveSheet.Name & " "" werden gelöscht", _
 _
 _
        vbYesNo + vbCritical, "CSV-Import starten ?")
    If Qe = vbNo Then
        MsgBox "CSV-Import abgebrochen"
        Exit Sub
    Else
        Cells.Clear
    End If

'Ordner auswählen
    With Application.FileDialog(msoFileDialogFolderPicker)
      .AllowMultiSelect = False
      .ButtonName = "Ordner wählen"
      .Title = "Bitte Haupt-ordner mit CSV-Dateien auswählen"
      .InitialView = msoFileDialogViewList
      If .Show <> False Then
        PFAD = .SelectedItems(1)
      Else
        Exit Sub
      End If
    End With
    
'Dateinamen einlesen
    Call ListFilesInFolder(SourceFolderName:=PFAD, _
          DateiFormat:="*.CSV", IncludeSubfolders:=True, FolderName:=True)
    If lCount = 0 Then
        MsgBox "Keine CSV-Dateien gefuden"
    Else
'Dateiliste abarbeiten
        For Each Datei In arrFiles
            freeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Datei, _
                Destination:=Range("A" & freeRow))
                .Name = Mid(Datei, InStrRev(Datei, "\") + 1)
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 850
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = True
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With
        Next
        Erase arrFiles: lCount = 0
    End If
End Sub



  

Betrifft: AW: Code für Einlesen aus ganzen Ordner abändern von: Hornung
Geschrieben am: 04.07.2015 15:00:19

Danke für deine Antwort, Thomas!
Leider kopiert der Code mir alles in eine Excel-Liste, ich bräuchte aber je .csv-Datei dann auch eine .xls/.xlsm-Datei.

Kann mir damit jemand behilflich sein? :)

VG Marcel


  

Betrifft: AW: Code für Einlesen aus ganzen Ordner abändern von: Hornung
Geschrieben am: 07.07.2015 17:38:48

Hat noch jemand eine Idee? :)


 

Beiträge aus den Excel-Beispielen zum Thema "Code für Einlesen aus ganzen Ordner abändern"