Microsoft Excel

Herbers Excel/VBA-Archiv

Cleanup und Ordnerstruktur

Betrifft: Cleanup und Ordnerstruktur von: Snewi
Geschrieben am: 21.11.2012 10:58:07

Hallo,
ich würde gerne wissen ob es in VBA die Möglichkeit gibt nach dem abspeichern verschiedener Dateien, diese direkt in eine Ordnerstruktur zu packen!

Ich habe Dateien mit YYYYMMDD - Bericht! Diese sollen jetzt den Ordnern Januar_YYYY bis Dezember_YYYY zugeordnet werden! Gibt es diesen Ordner schon - soll der Bericht hier abgelegt werden! Wenn nicht soll der Ordner erstellt werden!

Wie mache ich sowas?

gruß

  

Betrifft: AW: Cleanup und Ordnerstruktur von: Armin
Geschrieben am: 21.11.2012 11:13:11

Hallo, um Deine Frage zu beantworten: ja es geht.

Wenn Du jedoch mehr erwartet hast, musst Du schon ein wenig mehr dazu sagen. Was für Dateien, ganze Sheets oder nur Tabellen aus einem Sheet usw.

Gruß Armin


  

Betrifft: AW: Cleanup und Ordnerstruktur von: Snewi
Geschrieben am: 21.11.2012 11:28:27

Meine Frage war wie mache ich sowas?? Die Antwort: Ja es geht passt nicht ganz :-)

Ich lege ein PDF-File mit dem Namen YYYYMMDD - Bericht ab! Die Dateien liegen in meinem Pfad z.B.
C:\Archiv! Hier sollen jetzt die Dateien ich sag mal organisiert werden!

gruß


  

Betrifft: AW: Cleanup und Ordnerstruktur von: Armin
Geschrieben am: 21.11.2012 11:59:50

Hallo,
ich würde es so machen:

Function Ordner_vorhanden(strPath As String, Datum As Date)
Dim Nx$
On Error Resume Next
Nx = Dir(strPath, vbDirectory)
Do While Nx <> ""
    If Nx <> "." And Nx <> ".." Then
       If (GetAttr(strPath & Nx) And vbDirectory) = vbDirectory Then
          If strPath & Nx = strPath & CStr(Format(Datum, "mmmyyyy")) Then Exit Do
       End If
    End If
    Nx = Dir
Loop
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
MkDir strPath & CStr(Format(Datum, "mmmm_yyyy"))
Ordner_vorhanden = strPath & CStr(Format(Datum, "mmmm_yyyy")) & "\"
End Function

Die Funktion gibt den Pfad zurück. Wenn Du nicht direckt mit Datum arbeiten willst kannst Du den Ordner auch als String übergeben (Änderung).

Gruß Armin


  

Betrifft: AW: Cleanup und Ordnerstruktur von: Snewi
Geschrieben am: 21.11.2012 12:49:03

Da musst du mir noch ein wenig helfen! Wie benutze ich die Funktion genau??

Gruß


  

Betrifft: AW: Cleanup und Ordnerstruktur von: Armin
Geschrieben am: 21.11.2012 13:56:33

Hallo,
wie speicherst Du denn jetzt das File ab? Und dann musst Du ja irgend wann den Pfad übergeben. Dann benutzt Du die Funktion um den Verzeichnis-Namen bereitzustellen.
Dim Verzeichnis as String
Dim PDFFile as String
DIM aktDate as Date
aktDate=1.1.2013
PDFFile=“ 20130101-Bericht.pdf
Verzeichnis = Ordner_vorhanden(C:\Archiv, aktDate) - der erste Teil ist das Stammverzeichnis
‚jetzt legt er falls nicht vorhanden ein Verzeichnis an unterhalb von Archiv :
C:\Archiv\Januar_2013
Und jetzt benutzt Du das Verzeichnis & PDFFile zum speichern. Dieser Teil ist natürlich von Deinem Code zum speichern abhängig.


  

Betrifft: AW: Cleanup und Ordnerstruktur von: Snewi
Geschrieben am: 21.11.2012 14:13:20

Speicher immo so:

Sub KopiereBericht()
  Dim SpeicherName As String
  Dim Verzeichnis As String
  
  SpeicherName = "Bericht_" & Sheets("Bericht").Range("B5")
  Verzeichnis = "C:\Archiv"
  Sheets("Bericht").Copy
  Application.EnableEvents = False
  With ActiveSheet
    .Cells.Copy
    .Range("A1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    With .Parent
      With .VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        .DeleteLines 1, .CountOfLines
      End With
      .SaveAs Filename:=Verzeichnis & "\" & SpeicherName & "_.xlsx", _
          FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
      .Close
    End With
  End With
  Application.EnableEvents = True
  
End Sub

Gruß



  

Betrifft: AW: Cleanup und Ordnerstruktur von: Armin
Geschrieben am: 21.11.2012 14:22:37

Hallo,
dann müsste es so funktionieren:

Sub KopiereBericht()
  Dim SpeicherName As String
  Dim Verzeichnis As String
  Dim Pfad As String
  SpeicherName = "Bericht_" & Sheets("Bericht").Range("B5")
  Verzeichnis = "C:\Archiv"
  Sheets("Bericht").Copy
  Application.EnableEvents = False
  With ActiveSheet
    .Cells.Copy
    .Range("A1").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    With .Parent
      With .VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        .DeleteLines 1, .CountOfLines
      End With
      IF IsDate(Sheets("Bericht").Range("B5")) Then
         Pfad = Ordner_vorhanden(Verzeichnis, Sheets("Bericht").Range("B5"))
         'ich gehe davon aus das im Bericht [B5] das Datum steht!
         .SaveAs Filename:=Pfad & "\" & SpeicherName & "_.xlsx", _
          FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
         .Close
      end if 
    End With
  End With
  Application.EnableEvents = True
  
End Sub



  

Betrifft: AW: Cleanup und Ordnerstruktur von: Armin
Geschrieben am: 21.11.2012 14:44:09

Hallo, habe etwas übersehen:

Sub KopiereBericht()
  Dim SpeicherName As String
  Dim Verzeichnis As String
  Dim Pfad As String
  SpeicherName = "Bericht_" & Sheets("Bericht").Range("B5")
  Verzeichnis = "F:\!!Extern\T"
  Sheets("Bericht").Copy
  Application.EnableEvents = False
  With ActiveSheet
    '.Cells.Copy 'wird nicht gebraucht! 3x
    '.Range("A1").PasteSpecial xlPasteValues
    'Application.CutCopyMode = False
    With .Parent
      With .VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        .DeleteLines 1, .CountOfLines
      End With
      Pfad = Ordner_vorhanden(Verzeichnis, Sheets("Bericht").Range("B5"))
      'ich gehe davon aus das im Bericht [b5] das Datum steht!
      .SaveAs Filename:=Pfad & SpeicherName & "_.xlsx", _
          FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
      .Close
    End With
  End With
  Application.EnableEvents = True
End Sub
Jetzt müsste es funzen.

Gruß Armin


  

Betrifft: AW: Cleanup und Ordnerstruktur von: Snewi
Geschrieben am: 21.11.2012 15:01:35

Wieso wird cells.Copy nicht gebraucht? Ich möchte die Daten nur als Werte kopieren es sollen keine Formeln kopiert und eingefügt werden !!

Gruß


  

Betrifft: AW: Cleanup und Ordnerstruktur von: Armin
Geschrieben am: 21.11.2012 15:03:04

Hallo,
ok dann brauchst Du sie natürlich.


  

Betrifft: AW: Cleanup und Ordnerstruktur von: Snewi
Geschrieben am: 21.11.2012 15:13:04

OK,

dann soll Excel auch den Ordner selbstständig erstellen wenn nicht vorhanden!
Z.B. ich erstelle eine neue Datei 20121120 - Bericht.xlsx, dann soll Excel den Ordner November_2012 erstellen wenn dieser nicht vorhanden! Es sollen die Berichte dann für die Monate immer in den jeweiligen Monatsordner landen!

gruß


  

Betrifft: AW: Cleanup und Ordnerstruktur von: Armin
Geschrieben am: 21.11.2012 15:16:42

Hallo, ja macht es doch oder nicht. Es ist immer vom Datum in B5 abhängig.


  

Betrifft: AW: Cleanup und Ordnerstruktur von: Snewi
Geschrieben am: 21.11.2012 15:44:56

Hab vergessen die Function zu benutzen :-)
Danke läuft :-)