Code unklar

[Harald Friis]

Hallo,

gerade bin ich von m.p.d.excel hierher umgezogen, also erst einmal guten
Tag.

... und dann noch eine Frage: ich bin leider kein großer VBA-Kenner,
nutze aber einige Funktionen gerne und oft.

U.A. habe ich Makro, das mir Verzeichnisse erstellt. Ich drucke es unten ab.

Das müsste ich an zwei Punkten ändern:

- Die Wichtigste: derzeit schaut das Makro, ob in Zeile 2-16 die erste
Spalte gefüllt ist, dann erstellt er einen Ordner.

Neu müsste ich Ordner erstellen, die a) ein bestimmtes Kalender-Datum in
einem Feld und 'x' in einem anderen Feld stehen haben. Das Makro müsste
also ein Datum erfragen: "Welches Beginndatum?". Darauf werden dann alle
Ordner erstellt, die am fraglichen Datum, also z.B. am '20.01.2016'
angemeldet und - siehe Spalte 'Anwesend' - auch gekommen sind.

Kann man das so umbauen? Habt ihr Tipps für mich?

- Der Pfad: derzeit erfragt das Makro, wo die Ordner hingespeichert
werden sollen.

Neu: sie werden immer an dieselbe Stelle geschrieben. Könnte ich also
statt der Abfrage den Pfad fest einstellen? Ich habe es versucht, aber
bin leider auch gescheitert.

Danke für Hinweise oder Hilfen.

Gruß

Harald Friis

Sub Ordner()
Dim i As Integer
Dim sPfad As String
Dim AppShell As Object
Dim BrowseDir As Variant

' catch any errors
On Error GoTo ErrorHandling

' determine path
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Speicherort für
Serienbriefe auswählen", 0, 16)

If BrowseDir = "Desktop" Then
Path = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Else
Path = BrowseDir.items().Item().Path
End If

If Path = "" Then GoTo ErrorHandling

Path = Path & "\Ordner" & "\"
MkDir Path

On Error GoTo ErrorHandling

For i = 2 To 16
sPfad = Cells(i, 3).Value & "_" & Cells(i, 4).Value
If Cells(i, 1) <> "" Then MkDir Path & sPfad
Next

ErrorHandling:
Application.Visible = True

If Err.Number = 76 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly +
vbCritical
ElseIf Err.Number = 4198 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly +
vbCritical
ElseIf Err.Number = 91 Then
MsgBox "Exportieren abgebrochen", vbOKOnly + vbExclamation
ElseIf Err.Number > 0 Then
MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro
erneut ausführen.", vbOKOnly + vbCritical
Else
MsgBox "Ordner erfolgreich erstellt", vbOKOnly + vbInformation
End If

End Sub

[Hans Alborg]

Hallo Harald,

"Harald Friis" schrieb...
Könnte ich also statt der Abfrage den Pfad fest einstellen? Ich habe es
versucht, aber

bin leider auch gescheitert.

Es gibt oft Schreibfehler wenn man versucht einen Pfad einzutragen, ist mir
auch so gegangen.
Lass mal vom Originalcode den Pfad in eine Zelle schreiben!

Die Zeile

Tabelle2.Cells(10,10).value = Path

in den Code dort einfügen, wo der Pfad schon entstanden ist.
Tabelle2 (ggf. anpassen!) schreibt den Pfad in eine leeres Blatt damit es
nicht stört.

Jetzt den Zellinhalt in den Code Kopieren

Path = "...."

etwa. Dann hast Du die korrekte Schreibweise. Diese kannst Du jetzt noch
anpassen wenn nötig.

Dann direkt nach den DIM's die Ordnerwahl überspringen:

Goto fester_Pfad

[Code]

fester_Pfad:

Path = "...."
Path = Path & "\Ordner" & "\"
For i = ......

-----------------------------

Neu müsste ich Ordner erstellen, die a) ein bestimmtes Kalender-Datum in

einem Feld und 'x' in einem anderen Feld stehen haben.

Das Makro müsste also ein Datum erfragen: "Welches Beginndatum?"

-Bedeutet nicht dasselbe, sondern das oder ein höheres?

Du mußt ein Datum erst vorgeben. Oben erstmal eine Variable setzen, z.B:

Dim Beg_Datum As Date

Dann vor der Schleife z.B. eine Input- Box:

Beg_Datum = InputBox("Bitte Datum eingeben")

In der Schleife sollte es etwa so aussehen (beachte x / X):

For i = 2 To 16
if Cells(i,3).Value >= Beg_Datum AND _
Cells(i, 4).Value = "x" then
sPfad = Cells(i, 3).Value & "_" & Cells(i, 4).Value
MkDir Path & sPfad
End If
Next
....

Den Zeilen des Errorhandlings würde ich zum testen erstmal ein Hochkomma (')
davorsetzen um sie abzuschalten (die unter der Schleife).

Das ist mein Vorschlag in aller "Einfachheit". Für die Datumseingabe gibt es
noch weit bessere und "schickere" Möglichkeiten, aber das hier ist erstmal
was zum probieren.

Hans

[Harald Friis]

Hallo Hans,

Post by Hans Alborg
Hallo Harald,

[ viel Infos]

erst einmal vielen Dank. Ich werde es am WE mal testen und berichten
oder ggf. nachfragen.

Gruß

Harald Friis

[Harald Friis]

Hallo Hans,

klappt prima! Herzlichen Dank.

Post by Hans Alborg
Hallo Harald,
Path = "...."
Path = Path & "\Ordner" & "\"
For i = ......

Das Makro muss zwingend einen neuen Ordner erstellen? Es klappt so, wie
von dir oben angeben.

Was nicht klappt ist:

Path = "[ ]\Ordner
Path = Path & "\"

Ich kann also nicht immer wieder denselben Ordner nehmen, sondern muss
immer einen neuen Unterordner erstellen?

Ansonsten klasse, auch Datumeingabe (es wird in der Tat nur dieses feste
Datum erfragt)

Post by Hans Alborg
Das ist mein Vorschlag in aller "Einfachheit". Für die Datumseingabe
gibt es noch weit bessere und "schickere" Möglichkeiten, aber das hier
ist erstmal was zum probieren.

*Mir* reicht es längst. Super.

Gruß

Harald Friis

[Hans Alborg]

Hallo Harald,

"Harald Friis" schrieb...

Hans...
klappt prima! Herzlichen Dank.

Das freut mich.

Post by Hans Alborg
Path = "...."
Path = Path & "\Ordner" & "\"
For i = ......

Das Makro muss zwingend einen neuen Ordner erstellen? Es klappt so, wie
von dir oben angeben.
Path = "[ ]\Ordner
Path = Path & "\"

Klappt dieser Code nicht und wird kein Ordner erstellt?
Oder wird der Ordner durch die Schleife immer neu erzeugt (evtl. mit
angehängter Nummer)?

Falls Du Ordner erzeugen möchtest, deren Namen aus den 2 Spalten bestehen,
und die sollen nur in diesem einen Ordner landen,
laß mal die Zeile

Path = Path & "\Ordner" & "\"

weg und nur

Path = Path & "\"

übrig, und erstelle diesen Ordner händisch. Dann noch für diesen die Angaben
im Pfad anpassen.

Wenn das dann zum richtigen Ergebnis führt können wir mal drüber nachdenken
was der Code noch so leisten sollte. Zum Bsp. kann man den Ordner über eine
ähnliche Eingabe eintippen wie das Datum, und müßte sein Erstellen davon
abhängig machen, ob es ihn schon gibt (also den letzten Teil der Pfadangabe
prüfen oder so).

Wenn alles läuft, kannst Du auch die deaktivierten Zeilen (die mit GOTO
übersprungen werden und die mit dem Hochkomma davor) löschen, um die
Übersicht zu verbessern.

Wäre nett wenn Du dann nochmal den kompletten Code postest, der wird ja ein
ganzes Stück kürzer sein...

Hans

[Harald Friis]

Hallo Hans,

Post by Hans Alborg
Hallo Harald,
"Harald Friis" schrieb...

Ich habe mich wohl undeutlich ausgedrückt, bitte entschuldige.

Im ursprünglichen Code wurde ein neuer Ordner angelegt und in diesen
neuen Ordner wurden die leeren Verzeichnisse gespeichert.

Mit deinem Code klappt es, dass ich einen festen Pfad eingebe. Dann wird
an dieser Stelle aber ebenfalls ein neuer Unterordner ("Ordner\") angelegt.

Ich habe dann versucht, /nur/ den festen Pfad einzugeben, aber keinen
neuen Unterordner anlegen zu lassen. Da kam aber eine Fehlermeldung.

Post by Hans Alborg
Falls Du Ordner erzeugen möchtest, deren Namen aus den 2 Spalten
bestehen, und die sollen nur in diesem einen Ordner landen,
laß mal die Zeile
Path = Path & "\Ordner" & "\"
weg und nur
Path = Path & "\"
übrig, und erstelle diesen Ordner händisch. Dann noch für diesen die
Angaben im Pfad anpassen.

Genau hier kam eine Fehlermeldung (Fehler beim Zugriff auf Pfad/Datei}

Post by Hans Alborg
Wenn das dann zum richtigen Ergebnis führt können wir mal drüber
nachdenken was der Code noch so leisten sollte. Zum Bsp. kann man den
Ordner über eine ähnliche Eingabe eintippen wie das Datum, und müßte
sein Erstellen davon abhängig machen, ob es ihn schon gibt (also den
letzten Teil der Pfadangabe prüfen oder so).

Also gerne noch Kaffee kochen, den Abwasch machen .... ;-)

Nein, sonst ist eigentlich alles okay!

Post by Hans Alborg
Wäre nett wenn Du dann nochmal den kompletten Code postest, der wird ja
ein ganzes Stück kürzer sein...

Sub Ordner()
Dim i As Integer
Dim sPfad As String
Dim AppShell As Object
Dim BrowseDir As Variant
Dim Beg_Datum As Date
GoTo fester_Pfad
fester_Pfad:

Path = "C:\Users\[Name]\Documents\Ordner"
Path = Path & "\Ordner" & "\"
MkDir Path

On Error GoTo ErrorHandling

Beg_Datum = InputBox("Bitte Datum eingeben")
For i = 2 To 500
If Cells(i, 7).Value >= Beg_Datum And _
Cells(i, 18).Value = "x" Then
sPfad = Cells(i, 2).Value & "_" & Cells(i, 3).Value
MkDir Path & sPfad
End If
Next

ErrorHandling:
Application.Visible = True

If Err.Number = 76 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly +
vbCritical
ElseIf Err.Number = 4198 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly +
vbCritical
ElseIf Err.Number = 91 Then
MsgBox "Exportieren abgebrochen", vbOKOnly + vbExclamation
ElseIf Err.Number > 0 Then
MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro
erneut ausführen.", vbOKOnly + vbCritical
Else
MsgBox "Ordner erfolgreich erstellt", vbOKOnly + vbInformation
End If

End Sub

Danke und Gruß

Harald Friis

[Hans Alborg]

Hallo Harald,

"Harald Friis" schrieb...

Post by Harald Friis
Ich habe dann versucht, /nur/ den festen Pfad einzugeben, aber keinen
neuen Unterordner anlegen zu lassen. Da kam aber eine Fehlermeldung.

Wohl ab dem 2. Durchgang, weil der Ordner dann schon existierte?

Post by Harald Friis

Post by Harald Friis
Path = Path & "\"

Genau hier kam eine Fehlermeldung (Fehler beim Zugriff auf Pfad/Datei}

Ja da war noch was Überflüssiges dabei. Die obige Zeile!

Post by Harald Friis

Post by Harald Friis
davon abhängig machen, ob es ihn schon gibt (also den letzten Teil der
Pfadangabe prüfen oder so).

Also gerne noch Kaffee kochen, den Abwasch machen .... ;-)
Nein, sonst ist eigentlich alles okay!

Naja. bei mir hackte es noch, daher:

(Das unten kopieren, und meine Sprüche dazu (Zeilen mit den Hochkommas)
kannst Du im VBA- Editor löschen.
Und ich hab hier die Codezeilen umgebrochen, mit einem Space und dem
Unterstrich. Damit kann VBA umgehen)

'------------------------------
Sub Ordner_erstellen()
Dim i As Integer
Dim sPfad As String
Dim Beg_Datum As Date
Dim path As Variant
'
' den Wunschordner "Test" und den
' einzelnen Backslash vom alten
' Code gleich in diese Zeile
' mit rein, der Pfad muß
' aber schon existieren
' ("händisch erzeugt):
'
path = "C:\Users\[Username]\Test\"
Beg_Datum = InputBox _
("Bitte Datum eingeben")
For i = 2 To 500
If Cells(i, 7).Value >= Beg_Datum And _
Cells(i, 18).Value = "x" Then
sPfad = Cells(i, 2).Value & "_" & _
Cells(i, 3).Value
'
' hier folgt die Vermeidung eines
' gleich namigen Ordners.
' -gleicher Name: Stop,
' -neuer Name: Ordner wird erzeugt
' (statt Stop auch was anderes, wie
' z.B. EXIT SUB)
'
If Right(path & sPfad, Len(sPfad)) _
= sPfad Then
Stop
Else
MkDir path & sPfad
End If
'
' Wichtig, sPfad zurücksetzen!
'
sPfad = ""
End If
Next
End Sub
' ---------------------------------------

Ich hab's mit meinem Excel 2007 getestet. Dazu habe ich mir einen Button in
der "Symbolleiste für den Schnellzugriff" erstellt der das Makro startet.
Es wäre auch machbar, den Code auszulösen, wenn Du in der Datumsspalte ein
Datum anklickst. Das würde die Inputbox und das Datum tipseln sparen. Ist
aber evtl. zu "gefährlich". Daher könnte es dann wieder eine Message-Box
geben "15.1.2015 wirklich nehmen? j/n"

Oder so...

Hans

[Bernhard Sander]

Hallo Hans,

Post by Hans Alborg
If Right(path & sPfad, Len(sPfad)) _
= sPfad Then
Stop
Else
MkDir path & sPfad
End If

Bist Du sicher, dass Dein Programm das tut, was es tun soll?
Der Ausdruck im IF liefert nämlich grundsätzlich true, sodass nie ein Verzeichnis angelegt wird.

Denn Right(path & sPfad, Len(sPfad)) pappt zwar zuerst sPfad an path dran, schneidet anschließend aber den path wieder weg.
Im Endeffekt bleibt übrig If sPfad = sPfad, und das ist zwangsläufig true

Gruß
Bernhard Sander

[Hans Alborg]

Hi Bernhard,

"Bernhard Sander" schrieb...

Post by Bernhard Sander

Post by Hans Alborg
If Right(path & sPfad, Len(sPfad)) _
= sPfad Then

Bist Du sicher, dass Dein Programm das tut, was es tun soll?
Im Endeffekt bleibt übrig If sPfad = sPfad, und das ist zwangsläufig true

Du bringst mich ja zum Grübeln!!!

...und recht hast Du!
Also Kinder, nicht zuhause nachmachen!

Claus hat aber die Sache richtig angepackt, daran kann sich Harald halten.

Hans

[Claus Busch]

Hallo Hans,

Post by Hans Alborg
If Right(path & sPfad, Len(sPfad)) _
= sPfad Then
Stop
Else
MkDir path & sPfad
End If

du kannst doch mit Dir die Existenz des Ordners abfragen:

Sub Ordner_erstellen()
Dim i As Integer
Dim sPfad As String
Dim Beg_Datum As Date
Dim Pfad As String

Pfad = "C:\Users\Claus\Test\"
Beg_Datum = CDate(InputBox _
("Bitte Datum eingeben"))

For i = 2 To 500
sPfad = ""
If Cells(i, 7).Value >= Beg_Datum And _
Cells(i, 18).Value = "x" Then
sPfad = Cells(i, 2).Value & "_" & _
Cells(i, 3).Value
If Dir(Pfad & sPfad, vbDirectory) = "" Then MkDir Pfad & sPfad
End If
Next
End Sub


Mit freundlichen Grüßen
Claus

[Hans Alborg]

Hi Claus,

vSub Ordner_erstellen()
[...]

Das ist besser als meins und vor allem ohne Fehler. Leider weiß ich nicht
genau was Harald mit lauter leeren Ordnern anfängt, evtl. ist es ja
wünschenswert die gleichnamigen Ordner mit Nummer zu versehen oder so.

Jetzt kann er sich jedenfalls ein einigermaßen scharfes Werkzeug
zurechtbasteln.

Hans

[Harald Friis]

Hallo Hans, hallo Claus,

Post by Hans Alborg
Hi Claus,

vSub Ordner_erstellen()
[...]

Das ist besser als meins und vor allem ohne Fehler.

Danke euch Beiden. Das Makro läuft fehlerfrei - große klasse.

Leider weiß ich

Post by Hans Alborg
nicht genau was Harald mit lauter leeren Ordnern anfängt, evtl. ist es
ja wünschenswert die gleichnamigen Ordner mit Nummer zu versehen oder so.

X Teilnehmer werden zu einem Termin gemeldet, von denen N Teilnehmer
auch tatsächlich erscheinen. Für diese TN benötige ich einen Ordner für
alle Infos und Dokumente, die mit und um diesen TN herum im Laufe der
Tage produziert werden. Das lief bisher händisch :-(

Jetzt muss ich nur noch einen Word-Serienbrief dazu bewegen, seine
Ergebnisse in diesens Verzeichnis zu werfen, dann ist mir der ewige Dank
einer Kollegin sicher ;-)

Nochmals danke und Gruß

Harald Friis