Dateien aus Ordner einlesen

Hallo zusammen,
da bin ich wieder. Also nach wie vor bin ich eine Anfängerin in VBA, wobei ich aber schon einige fortschritte gemacht habe. Nun stehe ich aber vor einem großen Fragezeichen. Folgendes habe ich vor: Ich möchte ein Makro erstellen, dass alle Excel Dateien automatisch(alle im .xlsx Format) aus einem Ordner öffnet, die dann bearbeitet werden per Makro (Stpalten hin und her verschieben) und die Dateien dann in einem anderen Ordner als .CSV abspeichert. Die Dateien die ursprungsdateien (die im .xlsx Format) sollen gelöscht werden. Wichtig die Dateien dürfen nicht zusammengepackt werden. Den Teil mit dem bearbeiten der Spalten etc. per Makro habe ich schon hin bekommen, allerdings bin ich mir bei dem automatischen auslesen und speichern, löschen nicht sicher ob das Funktioniert und wenn Ja wie ?
Für eure Hilfe bin ich euch jetzt schon mal sehr sehr Dankbar.
Liebe Grüße
Eure Simone

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub fff() Dim strOrdner As String Dim objFSO As Object Dim objOrdner As Object Dim colDateien As Object Dim objDatei As Object Dim wkbkSource As Workbook Dim PfadCSV As String Dim NamenErstellt As String Application.ScreenUpdating = False Application.DisplayAlerts = False PfadCSV = "C:\Users\" & Environ("username") & "\Desktop\Test\" ' Anpassen des CSV Pfades With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = "C:\" .Title = "Ordnerauswahl" .ButtonName = "Auswahl..." .InitialView = msoFileDialogViewList If .Show = -1 Then strOrdner = .SelectedItems(1) If Right(strOrdner, 1) "\" Then strOrdner = strOrdner & "\" Else strOrdner = "" End If End With If strOrdner = "" Then MsgBox ("Kein Ordner gewählt!") Else Set objFSO = CreateObject("Scripting.FileSystemObject") Set objOrdner = objFSO.GetFolder(strOrdner) Set colDateien = objOrdner.Files For Each objDatei In colDateien If objFSO.GetExtensionName(objDatei) = "xlsx" Then Set wkbkSource = Workbooks.Open(objDatei) ' Mach was mit der geöffneten Datei (Dein Makro) wkbkSource.SaveAs Filename:=PfadCSV & Left(wkbkSource.Name, InStrRev( _ wkbkSource.Name, ".") - 1) & ".CSV", FileFormat:=xlCSV, CreateBackup:=False ' save CSV NamenErstellt = NamenErstellt & vbCr & wkbkSource.Name wkbkSource.Close False ' Datei Schließen Kill (objDatei) ' Datei Löschen End If Next objDatei Set wkbkSource = Nothing Set objFSO = Nothing Set objOrdner = Nothing Set colDateien = Nothing Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "Diese CSV Dateien Wurden Erstellt" & vbCr & NamenErstellt End If End Sub

Private Sub Durchlaufen() Dim Zelle As Range i = 1 For Each Zelle In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row) i = i + 1 If Zelle = Abs(Zelle) Then 'Prüft ob die Zahl positiv ist Cells(i, "G") = Cells(i, "A") Cells(i, "E").Value = 2 Else ' Wenn die Zahl negativ dann Cells(i, "H").Value = Zelle * -1 Cells(i, "E").Value = 3 End If Next End Sub

If strOrdner = "" Then MsgBox ("Kein Ordner gewählt!") Else Set objFSO = CreateObject("Scripting.FileSystemObject") Set objOrdner = objFSO.GetFolder(strOrdner) Set colDateien = objOrdner.Files For Each objDatei In colDateien If objFSO.GetExtensionName(objDatei) = "xlsx" Then Set wkbkSource = Workbooks.Open(objDatei) ' Mach was mit der geöffneten Datei (Dein Makro) Durchlaufen ' aufruf meiner Funktion wkbkSource.SaveAs Filename:=PfadCSV & Left(wkbkSource.Name, InStrRev( _ wkbkSource.Name, ".") - 1) & ".CSV", FileFormat:=xlCSV, CreateBackup:=False ' save CSV NamenErstellt = NamenErstellt & vbCr & wkbkSource.Name wkbkSource.Close False ' Datei Schließen Kill (objDatei) ' Datei Löschen End If Next objDatei

Ja du musst es auch so zuweisen das er weis auf welche Workbook und auf welchem Sheet er dein Makro machen soll =D
Dann probiere ma so
Gruß Basti

Sub fff()
Dim strOrdner As String
Dim objFSO As Object
Dim objOrdner As Object
Dim colDateien As Object
Dim objDatei As Object
Dim wkbkSource As Workbook
Dim PfadCSV As String
Dim NamenErstellt As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
PfadCSV = "C:\Users\" & Environ("username") & "\Desktop\Test\" ' Anpassen des CSV Pfades
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strOrdner = .SelectedItems(1)
If Right(strOrdner, 1)  "\" Then strOrdner = strOrdner & "\"
Else
strOrdner = ""
End If
End With
If strOrdner = "" Then
MsgBox ("Kein Ordner gewählt!")
Else
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOrdner = objFSO.GetFolder(strOrdner)
Set colDateien = objOrdner.Files
For Each objDatei In colDateien
If objFSO.GetExtensionName(objDatei) = "xlsx" Then
Set wkbkSource = Workbooks.Open(objDatei)
' Mach was mit der geöffneten Datei (Dein Makro)
Call Durchlaufen(wkbkSource.Worksheets(1))
wkbkSource.SaveAs Filename:=PfadCSV & Left(wkbkSource.Name, InStrRev( _
wkbkSource.Name, ".") - 1) & ".CSV", FileFormat:=xlCSV, CreateBackup:=False ' save  CSV
NamenErstellt = NamenErstellt & vbCr & wkbkSource.Name
wkbkSource.Close False ' Datei Schließen
Kill (objDatei) ' Datei Löschen
End If
Next objDatei
Set wkbkSource = Nothing
Set objFSO = Nothing
Set objOrdner = Nothing
Set colDateien = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Diese CSV Dateien Wurden Erstellt" & vbCr & NamenErstellt
End If
End Sub
Private Sub Durchlaufen(WS As Worksheet)
With WS
Dim Zelle As Range
i = 1
For Each Zelle In .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
i = i + 1
If Abs(Zelle) = Zelle Then 'Prüft ob die Zahl positiv ist
.Cells(i, "G") = Cells(i, "A")
.Cells(i, "E").Value = 2
Else  ' Wenn die Zahl negativ dann
.Cells(i, "H").Value = Zelle * -1
.Cells(i, "E").Value = 3
End If
Next
End With
End Sub

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Dateien aus Ordner einlesen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread