Gerne würde ich folgende Problemstellung in das Forum einbringen, in der Hoffnung, jemand kann mir weiterhelfen :-)
Mit dem untenstehenden Makro kann ich eine beliebige Anzahl von Dateien in einem bestimmten Verzeichnis öffnen, mittels dem Makro (der zwischen "Start des Codes!!!" und "Ende des Codes!!!" steht) bearbeiten und wieder abspeichern.
Dies funktioniert mit .xls, .xlsx, .xlsm wunderbar.
Nun wollte ich .csv Dateien bearbeiten, dies klappt leider nicht.
Wüsste jemand woran es liegt bzw. wie das Makro angepasst werden müsste damit auch CSV Dateien bearbeitet werden können?
Bin für jede Hilfe/Tipp sehr dankbar!
Beste Grüsse
Patrick
Option Explicit
Const strPath As String = "C:\Users\xxxx\Desktop\xxxxx\xxxxx\" 'Verzeichnis anpassen!!!
Dim strDir() As String
Dim Zeile As Long
Sub Main()
Dim strDateiname As String
Dim wkbBook As Workbook
Dim lngLastRowQ As Long
Dim lngLastRowZ As Long
Dim lngLastCol As Long
Dim intCalc As Integer
Dim i As Long
On Error GoTo Fin
With Application
.ScreenUpdating = False
.AskToUpdateLinks = False
.EnableEvents = False
intCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
'strDateiname = Dir$(ThisWorkbook.Path & "\*.xls") Dateityp anpassen!!!
Zeile = 1
Tree strPath, "*.csv", True
For Zeile = 1 To UBound(strDir)
Set wkbBook = Workbooks.Open(strDir(Zeile))
' Start des Codes!!!
' Ende des Codes!!!
wkbBook.Close savechanges:=True ' True wenn gespeichert werden soll, False wenn nicht!!!
Set wkbBook = Nothing
Next Zeile
Fin:
Set wkbBook = Nothing
With Application
.ScreenUpdating = True
.AskToUpdateLinks = True
.EnableEvents = True
.Calculation = intCalc
.DisplayAlerts = True
End With
If Err.Number 0 Then
MsgBox "Error: " & Err.Number & " " & Err.Description
End If
MsgBox "Done!", vbInformation
End Sub
'________________________________________________________________________
'Code von Bernd (bst)
'http://www.online-excel.de/fom/fo_read.php?f=3&bzh=121&h=120#a123x
Sub Tree(actdir As String, filename As String, showfiles As Boolean)
Dim fname
Dim i As Integer, j As Integer
Dim subdirs() As String
Call ShowDir(actdir, filename, showfiles)
i = 0
fname = Dir(actdir & "\*.*", vbDirectory)
While fname ""
If fname "." And fname ".." And (GetAttr(actdir & "\" & fname) And vbDirectory) = _
vbDirectory Then
i = i + 1
ReDim Preserve subdirs(i)
subdirs(i) = actdir & "\" & fname
End If
fname = Dir
Wend
For j = 1 To i
Call Tree(subdirs(j), filename, showfiles)
Next
ReDim subdirs(0)
End Sub
Private Sub ShowDir(actdir As String, filename As String, showfiles As Boolean)
Dim fname
If showfiles Then
fname = Dir(actdir & "\" & filename)
While fname ""
ReDim Preserve strDir(1 To Zeile)
strDir(Zeile) = actdir & "\" & fname
'Cells(Zeile, 1).Value = actdir & "\" & fname
Zeile = Zeile + 1
fname = Dir
Wend
Else
ReDim Preserve strDir(1 To Zeile)
strDir(Zeile) = actdir & "\" & fname
'Cells(Zeile, 1).Value = actdir
Zeile = Zeile + 1
End If
End Sub