Ein Extra für einen lern-lustigen Fragesteller

[d'r Bastler]

Moin allerseits,
im Forum nebenan wurde die Aufgabe gestellt, eine aktive Mappe als PDF und XLSM auf eine USB-Stick zu speichern, wenn denn einer bereit ist. Den letzten Teil der Aufgabe hat der nette Mensch schon selbst mitgebracht, es ging in erster Linie um die Dateinamen der Ausgabe.

Es gab tatsächlich mehrere Vorschläge (erfreulich!) und der schlimme Finger hat sich gegen meinen entschieden , aber versprochen, dass er ihn noch einmal besichtigt, um ihn zu verstehen. Das lobe ich mir! und belohne es gerne mit ausführlich kommentiertem Code (gehört in ein Modul)

Code: Alles auswählen

Option Explicit		'zwingt zur Deklaration der Variablen und ist ein Muss am Anfang jeden Moduls, vermeidet Tippfehler-Probleme

Sub VBAstel_Test_FSO()
Dim wb As Workbook, FSO As Object, oDrv As Object               'Variable bekommen bis auf wenige Ausnahmen ihren Typ als Prefix sXX = String, oXXX = Object
Dim sPath As String, sDrv As String, sFile As String            'in FSO steckt Object schon drin, also ohne Prefix, wb und ws sind ewige Standards, also kurz
Dim sPDF As String, sXLSM As String                             'engl. deswegen, weil LW in den Eigenschaften als Drives erscheinen, daher oDrv

Set wb = ActiveWorkbook                                         'hier kann man auch ThisWorkbook setzen, dann passiert der Code in der Mappe, in der er aufgerufen wird
Set FSO = CreateObject("Scripting.filesystemobject").Drives     'hier wird die Mutter aller Laufwerke als Objekt gesetzt

sPath = wb.Path & "\"                                                                           'ohne "\" klemmt's gewaltig
sFile = "Monatslisten-Abschluss " & Format(DateSerial(Year(Now), Month(Now), 0), "MMMM YYYY")   'das Namenskonstrukt muss nur einmal gebaut werden
sPDF = sFile & ".pdf": sXLSM = sFile & ".xlsm"                                                  'die zwei Exts als Ergänzung in einer Zeile, kombiniert durch den ":"

For Each oDrv In FSO                                            'Beginn Schleife
     If oDrv.IsReady And oDrv.DriveType = 1 Then                    'Bedingung
        sDrv = oDrv.DriveLetter & ":\"                              'sDrv mit dem ":\" - ohne klemmt's gewaltig, der Laufwerksbuchstab als Ergänzung
        sPDF = sDrv & sPDF                                          'hier wird das .pdf zusammengesetzt
        sXLSM = sDrv & sXLSM                                        'hier das .xlsm
        Debug.Print sPDF                                            'Debug.print dient der Zwischenkontrolle der zusammengesetzten Variablen
        Debug.Print sXLSM                                           ' und ist im Direktfenster sichtbar
    End If                                                      'Bedingung Ende
Next oDrv                                                       'Schleife Ende

With wb                                                         'öffnet die Reihe der Argumente für wb
    .Save                                                                               'speichern
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPDF, Quality:=xlQualityStandard    'als PDF ausgeben
    .SaveCopyAs sXLSM                                                                   'als XLSM ausgeben
End With                                                        'schließt die Reihe

Set FSO = Nothing                                               'Freigeben des Objekts

End Sub

Grüße vom Abschluss: man schreibt mich seit 2006 schon nicht mehr mit "ß"

Schönen Amnd noch!

Nachtrag: Das FileSystemObject benötigt unter VBE / Extras / Verweise die Microsoft Scripting Runtime

[knobbi38]

Hallo,

FSO als Variablenname für eine Drives-Auflistung?
Btw.: bei Late-Binding mit CreateObject() wird keine Verweis benötigt.

Der Vormonat könnte auch mit Format(Dateadd("m",-1,Date),"MMMM YYYY") ermittelt werden. Grundsätzlich ziehe ich aber eine Monatsnummer gegenüber Monatsnamen in Dateiangaben vor, schon um besser sortieren zu können und keine Sprachvarianten einführen zu müssen. Eine Angabe im ISO-Format wäre eigentlich optimal für eine spätere Weiterverarbeitung.

Gruß Knobbi38

[Paul1206]

Hallo,

hier mal noch zur Ergänzung die Sache mit Early Binding in Kurzfassung (falls mal Bedarf/Interesse besteht):

Code: Alles auswählen

Sub test()  ' Early Binding Bibliothek MS Sripting Runtime
    Dim LW As Scripting.FileSystemObject, oLw As Drive
    Set LW = New Scripting.FileSystemObject
    For Each oLw In LW.Drives
        If oLw.DriveType = 1 Then
            MsgBox oLw.DriveLetter
        End If
    Next
End Sub

Gruß Uwe

[Kruemi]

Moin Bastler,
hab vielen Dank für die Veröffentlichung.
Da habe ich dann was zu lesen für die Abendstunden.

Grüße an den Abschluss/ß zurück --> ich war in den Neunzigern in der Schule, kenne also den neumodischen kram nicht

Danke und alles Gute
Kruemi

[d'r Bastler]

Moin Kruemi,

Willkommen hier

Aber großes Sorry - auf die Steilvorlage "neumodischen Kram" muss ich reagieren.
Meine Schulzeit begann in den 1960^ern, aber trotz allem Hollareduliö 1979 endlich aus der Penne raus zu sein, habe ich mir das Lernen nicht abgewöhnt

Schöne Grüße!

[Kruemi]

Danke Danke,
Das ist völlig OK, ein bisschen Spaß muss sein
Kann ich dann Papi Bastler sagen. Würde ja fast passen
Natürlich lernt man sein ganzes Leben weiter und auch ich habe es nicht aufgegeben, nur manche Sachen sind wichtiger als andere.

de Grüße

[d'r Bastler]

Jetzt wird der Krümel dreist!!

Papi Bastler

...

Na warte - Früchtchen!!

Schönen Amnd!

[d'r Bastler]

Moin allerseits,

eben habe ich hier meinen Tatortreiniger online gestellt. Das Ergebnis mit angewandt auf den Code in #1:

Code: Alles auswählen

Option Explicit

Sub VBAstel_Test_FSO()
Dim wb As Workbook, FSO As Object, oDrv As Object
Dim sPath As String, sDrv As String, sFile As String
Dim sPDF As String, sXLSM As String

Set wb = ActiveWorkbook
Set FSO = CreateObject("Scripting.filesystemobject").Drives

sPath = wb.Path & "\"
sFile = "Monatslisten-Abschluss " & Format(DateSerial(Year(Now), Month(Now), 0), "MMMM YYYY")
sPDF = sFile & ".pdf": sXLSM = sFile & ".xlsm"

For Each oDrv In FSO
     If oDrv.IsReady And oDrv.DriveType = 1 Then
        sDrv = oDrv.DriveLetter & ":\"
        sPDF = sDrv & sPDF
        sXLSM = sDrv & sXLSM
        Debug.Print sPDF
        Debug.Print sXLSM
    End If
Next oDrv

With wb
    .Save
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPDF, Quality:=xlQualityStandard
    .SaveCopyAs sXLSM
End With

Set FSO = Nothing

End Sub

Sieht doch besser aus - oder?

Viele Grüße