Dateien abarbeiten

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Dateien abarbeiten von: P.W.
Geschrieben am: 15.02.2005 18:01:53

Hallo Zusammen,

ich habe folgendes Problem.
Ich hab ein Makro geschrieben, in dem im ersten Schritt alle Dateien eines Pfades untereinander in Zeilen geschrieben werden:
___________________________________________________________

Sub Pfad_auslesen()
' Listet alle Dateien aus einem Verzeichnis
   Pfad = Range("A1")   ' Zelle mit dem Start-Pfad (hier A1)
    With Application.FileSearch   ' Alle Dateien suchen
     .NewSearch
     .LookIn = Pfad
     .Filename = "*.*"
     .Execute
     For i = 1 To .FoundFiles.Count
      ' Dateien ab aktuellem Cursor in Spalten einfügen
      ActiveCell.Offset(1, 0).Activate
      ActiveCell = .FoundFiles(i)
      ' oder wahlweise in spezifizierte Zellen
      ' Cells(1 + i, 1) = .FoundFiles(i)
     Next
    End With
End Sub

________________________________________________________________

Jetzt möchte ich, das ein anderes Formatierungsmakro die einzelnen Dateien aufruft, "durchnudelt" und dann in die nächste Zeile springt und die nächste Datei öffnet usw.. Dies soll solange geschehen, bis kein Zelleninhalt(=Pfadangabe) mehr vorhanden ist.
Leider kann ich mich nicht "hart" auf die einzelnen Zellen/ Zeilen beziehen, da die Anzahl der zu verabreitenden Dateien unterschiedlich sind.
soweit bin ich bisher gekommen mit harten Zellbezügen (B4 und B5)
____________________________________________________________
Sub Total_KST()
'
' KST_2 Makro
' Makro am 14.02.2005 von P.W. aufgezeichnet
'
'
    Workbooks.Open Filename:=Range("B4")
    Application.Run "Mappe2!KST_Bericht_einstellen"
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Workbooks.Open Filename:=Range("B5")
    Application.Run "Mappe2!KST_Bericht_einstellen"
    ActiveWorkbook.Save
    ActiveWorkbook.Close
End Sub

_______________________________________________________

Wie kann ich via VBA sagen, starte in B4 und gehe solange nach unten weiter, bis Du auf eine leere Zelle triffst, dann soll das Makro stoppen.

Ich danke Euch schon jetzt

P.S. Kan Makros nur aufnehmen, leider nicht selber schreiben

P.W.
Bild


Betrifft: AW: Dateien abarbeiten von: Willie
Geschrieben am: 15.02.2005 18:15:13

Hallp P.W.

versuch es mal so hier werden deine Dateien von a1 bis a10 geöffnet!
Gruß
Willie

Rückmeldung wäre nett

Sub Total_KST()
For i = 1 To 10
dateiname = Cells(i, 1).Value
If Cells(i, 1).Value = "" Then Exit Sub
    Workbooks.Open Filename:=dateiname
    Application.Run dateiname
    ActiveWorkbook.Save
    ActiveWorkbook.Close
Next
End Sub



Bild


Betrifft: AW: Dateien abarbeiten von: P.W.
Geschrieben am: 15.02.2005 21:57:00

Hallo Willi,

vielen Dank für Deine Mühen!!!
Irgendwie habe ich diesen Code nicht ans laufen gebracht, was aber nicht zwangsläufig bedeutet, dass er falsch ist.

Danke auf jedenfall nochmal!!

Peter


Bild


Betrifft: AW: Dateien abarbeiten von: Josef Ehrensberger
Geschrieben am: 15.02.2005 18:16:15

Hallo P.W. ?

Probier mal so.

Sub Total_KST()
Dim wkb As Workbook
Dim lastRow As Long, lRow As Long
On Error GoTo ERRORHANDLER
Application.ScreenUpdating = False
lastRow = IIf(Range("B65536") <> "", 65536, Range("BA65536").End(xlUp).Row)
'letzte gefüllte Zelle in Spalte "B" ermitteln
If lastRow < 4 Then lastRow = 4
   For lRow = 4 To lastRow    'start in Zeile 4
   
   Set wkb = Workbooks.Open(Filename:=Cells(lRow, 2))
   
   Application.Run "Mappe2!KST_Bericht_einstellen"
   
   wkb.Close True
   
NOBOOK:
   Set wkb = Nothing
   
   Next
ERRORHANDLER:
If Err.Number = 1004 Then
Err.Clear
GoTo NOBOOK
End If
Application.ScreenUpdating = True
End Sub



Gruß Sepp

P.S.: Rückmeldung nicht vergessen!


Bild


Betrifft: AW: Dateien abarbeiten von: P.W.
Geschrieben am: 15.02.2005 22:02:52

Hallo Sepp,

erst habe ich den Code nicht ans laufen gebracht, doch nach einer kleinen "Schönheitsoperation" klappt es nun.

Du hast geschrieben (Auszug)
lastRow = IIf(Range("B65536") <> "", 65536, Range("BA65536").End(xlUp).Row)

Es muss heissen (Auszug)
lastRow = IIf(Range("B65536") <> "", 65536, Range("B65536").End(xlUp).Row)

Bei der zweiten Range "Bedingung" ist das A zuviel.

Hast mir echt super weitergeholfen, nochmals vielen Dank

Peter


Bild


Betrifft: AW: Dateien abarbeiten von: Josef Ehrensberger
Geschrieben am: 15.02.2005 22:07:45

Hallo Peter!

Das kommt davon, wenn man ungetesteten Code weitergibt ;-))

Gruß Sepp


Bild


Betrifft: AW: Dateien abarbeiten von: P.W.
Geschrieben am: 15.02.2005 22:13:18

Hallo Sepp,

kein Thema.

Nachdem Du aber recht fit bist in sachen VBA habe ich doch noch gleich eine andere Frage an Dich und zwar, ist es möglich, über ein Drop Down Menü einen Verzeichnispfad auszuwählen? Die Drop Down Auswahl soll quasi den Explorerverzeichnisbaum wiederspiegeln. Geht sowas??

Danke schonmal für Deine Antwort

Peter


Bild


Betrifft: AW: Dateien abarbeiten von: Josef Ehrensberger
Geschrieben am: 15.02.2005 22:21:50

Hallo Peter!

DropDown nicht, aber probier das mal.


      
'Created By Chip Pearson and Pearson Software Consulting Services
'\'a9 Copyright 1997-2003 Charles H. Pearson
' http://www.cpearson.com/excel/BrowseFolder.htm
Option Explicit
'Using the Shell Controls Library
'
'First you need to set a reference to the "Microsoft Shell
'Controls And Automation" object library.
'In the VBA Editor, go to the Tools menu, choose References,
'and scroll down to this item and put a check next to it.
'
'Then, copy the following code to a standard code module:
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260
   
Function BrowseFolder(Optional Caption As String, _
   
Optional InitialFolder As StringAs String
   
Dim SH As Shell32.Shell
   
Dim F As Shell32.Folder
   
Set SH = New Shell32.Shell
   
Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, _
   InitialFolder)
   
If Not F Is Nothing Then
      BrowseFolder = F.Items.Item.Path
   
End If
End Function
'You can the call the BrowseFolder function with the following code:
   
Sub OpenFolder()
   
Dim FName As String
   FName = BrowseFolder(
"Select a folder""C:\")
   
If FName = "" Then
      MsgBox 
"You didn't select a folder"
   
Else
      MsgBox 
"You selected: " & FName
   
End If
End Sub 


     Code eingefügt mit Syntaxhighlighter 3.0


Du musst im VBE unter "Extras" > "Verweise" , den Verweis auf
"Microsoft Shell Controls And Automation"
setzen!

Gruß Sepp

P.S.: Rückmeldung nicht vergessen!


Bild


Betrifft: AW: Dateien abarbeiten von: P.W.
Geschrieben am: 15.02.2005 22:33:42

Hllo Sepp,

seeeeeeeeeeeeehr geil !!!

wenn Du mir jetzt nur noch sagen kannst, wie ich es hinbekomme, dass der ausgewählte Pfad in der Celle A1 als steht, dann ist der Tag komplett perfekt !!!

Ich bin mir sicher, Du kannst das !!!

100 Dank

Peter


Bild


Betrifft: AW: Dateien abarbeiten von: Josef Ehrensberger
Geschrieben am: 15.02.2005 22:43:43

Hallo Peter!

Du draust mir aber was zu;-)

Sub OpenFolder()
   Dim FName As String
   FName = BrowseFolder("Select a folder", "C:\")
   If FName <> "" Then
      Sheets("Tabelle1").Range("A1") = FName
   End If
End Sub 



Gruß Sepp

P.S.: Rückmeldung nicht vergessen!


Bild


Betrifft: AW: Dateien abarbeiten von: P.W.
Geschrieben am: 15.02.2005 22:53:21

Der Mann ist der Hammer !!!

Ein Traum !!! Vielen vielen Dank

Peter


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Dateien abarbeiten"