VBA - Dateien öffnen -> Wert ersetzen -> Speichern

Hallo,
ich als VBA-Laie habe mal eine Frage bzw. eine Bitte:
Ich muss mehrere hundert Dateien (Endung .sch) einmal öffnen, dann jeweils alle "[" und "]" in dem gesamten Dokument durch " " ersetzen und anschließen die Datei als .xlsx wieder mit gleicher Nummerierung wieder abspeichern.
Die Dateien "Datei1"-"Datei1000" liegen alle im selben Verzeichnis "C:\Desktop\Beispiel".
In jeder Datei sollen alle eckigen Klammern "[" und "]" gelöscht bzw. durch ein Leerzeichen ersetzt werden.
Abgespeichert sollen die Dateien dann auch wieder "Datei1.xlsx" - "Datei1000.xlsx" heißen und im Verzeichnis "C:\Desktop\Beispiel\Konvertiert" liegen.
Es wäre wirklich super, wenn mir jemand helfen könnte!!!!
LIEBEN DANK LEUTE!!!!
Salocinz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Makro1() Dim loLetzte As Long Workbooks.OpenText Filename:="C:\Desktop\Beispiel\Beispiel1.sch", Origin _ :=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(0, 1), _ TrailingMinusNumbers:=True With ActiveSheet loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row .Range(.Cells(1, 1), .Cells(loLetzte, 1)).Replace What:="[", Replacement:=" ", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False .Range(.Cells(1, 1), .Cells(loLetzte, 1)).Replace What:="]", Replacement:=" ", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False .Columns("A:A").AutoFit End With End Sub

Sub Makro1() Dim loLetzte As Long, loSpalte As Long Dim strPath As String, strDateiname As String Application.ScreenUpdating = False Workbooks.OpenText Filename:="C:\Desktop\Beispiel\Beispiel1.sch", Origin _ :=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, Tab:=True, TrailingMinusNumbers:=True With ActiveSheet loLetzte = .UsedRange.Rows.Count loSpalte = .UsedRange.Columns.Count .Range(.Cells(1, 1), .Cells(loLetzte, loSpalte)).Replace What:="[", Replacement:=" ", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False .Range(.Cells(1, 1), .Cells(loLetzte, loSpalte)).Replace What:="]", Replacement:=" ", _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False .Range(.Cells(1, 1), .Cells(1, loSpalte)).EntireColumn.AutoFit strPath = ThisWorkbook.Path & "\" strDateiname = .Name .SaveAs Filename:=strPath & strDateiname, FileFormat:=xlWorkbookDefault ActiveWorkbook.Close End With Application.ScreenUpdating = True End Sub

Hallo,
hier jetzt mit einer Schleife über alle Dateien im Ordner mit der Endung .sch
Den Zielordner habe ich jetzt im Code direkt angegeben. Es ist also egal, in welchem Ordner sich die Datei mit dem Makro befindet.

Option Explicit
Sub Makro1()
Dim loLetzte As Long, loSpalte As Long
Dim strPathQuelle As String, strFileQuelle As String, strExt As String
Dim strPathZiel As String, strFileZiel As String
Application.ScreenUpdating = False
strPathQuelle = "C:\Desktop\Beispiel\"
strExt = "*.sch"
If strPathQuelle = "" Then
Exit Sub
Else
strFileQuelle = Dir(strPathQuelle & strExt)
Do While Len(strFileQuelle) > 0
Workbooks.OpenText Filename:=strPathQuelle & strFileQuelle, Origin _
:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, Tab:=True, TrailingMinusNumbers:=True
With ActiveSheet
loLetzte = .UsedRange.Rows.Count
loSpalte = .UsedRange.Columns.Count
.Range(.Cells(1, 1), .Cells(loLetzte, loSpalte)).Replace _
What:="[", Replacement:=" ", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Range(.Cells(1, 1), .Cells(loLetzte, loSpalte)).Replace _
What:="]", Replacement:=" ", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Range(.Cells(1, 1), .Cells(1, loSpalte)).EntireColumn.AutoFit
strPathZiel = "C:\Desktop\Beispiel\Konvertiert\"
strFileZiel = .Name
.SaveAs Filename:=strPathZiel & strFileZiel, FileFormat:=xlWorkbookDefault
ActiveWorkbook.Close
strFileQuelle = Dir()
End With
Loop
End If
Application.ScreenUpdating = True
End Sub

Im Code ist aber keine Prüfung eingebuat, ob der/die Ordner schon existiert.
Gruß Werner

Beliebteste Forumthreads (12 Monate)

VBA - Dateien öffnen -> Wert ersetzen -> Speichern

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

359 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA - Dateien öffnen -> Wert ersetzen -> Speichern

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

359 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread