Dateien im Ordner öffenen; Ändern und speichern

Forumthread: Dateien im Ordner öffenen; Ändern und speichern

31.07.2014 09:37:35

Mike

Hallo Zusammen,
ich möchte mit Hilfe eines Makros alle Dateien in einem Ordner nacheinander öffnen. Dabei soll das Makro jede Datei aufmachen, die Werte in einer Spalte ändern und die Änderung speichern. Soviel hab ich schon mal rausgefunden:
Range("B2").Select
ActiveCell.FormulaR1C1 = "25"
Selection.AutoFill Destination:=Range("B2:B601")
Range("B2:B601").Select
ActiveWorkbook.Save
ActiveWindow.Close
jedoch habe ich so wenig VBA-Erfahrung, das ich auf eure Hilfe angewiesen bin. Weiß nicht, wie ich den Rest umsetzen kann. Hoffe mir kann einer helfen.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dateien im Ordner öffenen; Ändern und speichern

31.07.2014 10:02:12

Hajo_Zi


Option Explicit
' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.
' Der VB Code ist aus dem Beitrag  _
http://www.activevb.de/tipps/vb6tipps/tipp0492.html
' Verweis: Microsoft Scripting Runtime
' Originalcode
'Dim i As Long
'With Application.FileSearch
'    .NewSearch
'    .LookIn = ActiveWorkbook.Path   'Suchverzeichnis
'    .SearchSubFolders = False       'True wäre mit Unterverzeichnissen
'    .Filename = "*.csv"             'Dateien die mit .csv änden
'    .Execute                        'suche ausführen
'    For i = 1 To .FoundFiles.Count
'        Application.StatusBar = "-->>   Einlesen der Datei:  " & i & " / " & .FoundFiles.Count  _
& "

AW: Dateien im Ordner öffenen; Ändern und speichern

31.07.2014 10:22:21

Tino

Hallo,
hier eine Variante zum testen!
Pfad wo die Dateien liegen und die Tabelle noch anpassen!

Sub Start()
Dim sDir$, sPath$, sFehler$
Dim arFiles()
Dim n&
'Pfad angeben *********************** 
sPath = "G:\Ordner\Neuer Ordner\"

If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

sDir = Dir$(sPath & "*.xls?", vbNormal)
Do While sDir <> ""
    Redim Preserve arFiles(n)
    arFiles(n) = sDir
    n = n + 1
    sDir = Dir$()
Loop

If n > 0 Then
    Events_ False
    On Error Resume Next
    For n = Lbound(arFiles) To Ubound(arFiles)
        With Workbooks.Open(sPath & arFiles(n))
            If Not .ReadOnly Then
                'Tabelle angeben ********************** 
                .Sheets("Tabelle1").Range("B2:B601").Value = 25
                If Err.Number = 0 Then
                    .Close True
                Else
                    sFehler = sFehler & arFiles(n) & " - Fehler: " & Err.Number & vbCr
                    .Close False
                    Err.Clear
                End If
            Else
                sFehler = sFehler & arFiles(n) & " - Schreibgeschützt" & vbCr
                .Close False
            End If
        End With
    Next n
    Events_ True
End If

If sFehler <> "" Then
    sFehler = Left$(sFehler, Len(sFehler) - 1)
    MsgBox "Datei mit Fehler!" & vbCr & vbCr & sFehler, vbExclamation
Else
    MsgBox "Fertig!", vbInformation
End If
End Sub

Sub Events_(booSchalter As Boolean)
With Application
    .ScreenUpdating = booSchalter
    .EnableEvents = booSchalter
    .DisplayAlerts = booSchalter
    .Calculation = IIf(booSchalter, xlCalculationAutomatic, xlCalculationManual)
End With
End Sub

Gruß Tino

AW: Dateien im Ordner öffenen; Ändern

31.07.2014 10:38:05

Mike

Vielen Dank erst mal Tino,
leider schmeißt der da noch irgendwie was durcheinander:
https://www.herber.de/bbs/user/91804.zip

AW: Dateien im Ordner öffenen; Ändern

31.07.2014 11:04:09

Mike

mir ist gerade noch was aufgefallen....und zwar hat die Tabelle immer den Namen der Datei....und wie gesagt schmeißt er da was durcheinander.....sorry aber wie ihr merkt hab ich keinen Plan

CSV Dateien

31.07.2014 12:50:56

Tino

Hallo,
hättest ja sagen können das sich um CSV Dateien handelt,
sind ja eigentlich Textdateien mit vorgegebenen Trennzeichen.

Sub Start()
Dim sDir$, sPath$, sInhalt$
Dim arFiles()
Dim varInhalt, varTmp
Dim n&, nn&
Dim F%

Const sDelimiter$ = ";" 'TRennzeichen 

sPath = "C:\Ordner\Ordner\" 'Pfad anpassen 

If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

sDir = Dir$(sPath & "*.csv", vbNormal)
Do While sDir <> ""
    Redim Preserve arFiles(n)
    arFiles(n) = sDir
    n = n + 1
    sDir = Dir$()
Loop

If n > 0 Then
    For n = Lbound(arFiles) To Ubound(arFiles)
        F = FreeFile
        Open sPath & arFiles(n) For Binary As #F
        sInhalt = Space$(LOF(F))
        Get #F, , sInhalt
        Close
        
        varInhalt = Split(sInhalt, vbCrLf)
        Kill sPath & arFiles(n)
        
        F = FreeFile
        Open sPath & arFiles(n) For Append As #F
        
        For nn = Lbound(varInhalt) To Ubound(varInhalt)
            If nn > 0 Then
                varTmp = Split(varInhalt(nn), sDelimiter)
                If Ubound(varTmp) > 0 Then varTmp(1) = 25
                sInhalt = Join(varTmp, sDelimiter)
            Else
                sInhalt = varInhalt(nn)
            End If
               
            Print #F, sInhalt
        Next nn
        
        Close #F
    Next n
End If


MsgBox "Fertig!", vbInformation

End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

Dateien im Ordner öffenen; Ändern und speichern

Forumthread: Dateien im Ordner öffenen; Ändern und speichern

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Dateien im Ordner öffenen; Ändern und speichern

Forumthread: Dateien im Ordner öffenen; Ändern und speichern

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread