Datei mit Zell-Wert als Name speichern

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

Betrifft: Datei mit Zell-Wert als Name speichern
von: Andi
Geschrieben am: 02.11.2003 13:12:10

Hallo Leute!

Wie kann ich per VBA eine Datei mit dem Namen speichern, der in einer bestimmten Zelle eingetragen wurde.
Zusätzlich soll (im Format "Name _ 15.11.03-14Uhr37" ) auch das Datum und die Uhrzeit im Datei-Namen erscheinen.

Vorab schon mal vielen Dank für eure Hilfe!

Bild


Betrifft: AW: Datei mit Zell-Wert als Name speichern
von: Ramses
Geschrieben am: 02.11.2003 13:19:42

Hallo

Option Explicit


Sub Save_as_Name_Date_and_Time()
Dim myDate As String, myTime As String
myDate = Format(Date, "dd.mm.yyyy")
myTime = Format(Now, "hh-mm-ss")
ThisWorkbook.SaveAs Filename:="C:\" & Range("a1").Value & "_" & myDate & " " & myTime
End Sub


Gruss Rainer


Bild


Betrifft: AW: Datei mit Zell-Wert als Name speichern
von: Andi
Geschrieben am: 02.11.2003 14:10:45

Hallo Ramses, das ging ja super schnell und einfach.

Herzlichen Dank!


Bild


Betrifft: AW: Datei mit Zell-Wert als Name speichern
von: K.Rola
Geschrieben am: 02.11.2003 14:17:54

Hallo,

du solltest zumindest(wenn auch nicht programmiertechnisch korrekt)
ein On Error resume next einbauen, für den Fall, dass in der Zelle
Zeichen stehen, die in Dateinamen nicht erlaubt sind.

Gruß K.Rola


Bild


Betrifft: Dann aber richtig ....
von: Ramses
Geschrieben am: 02.11.2003 15:03:11

Hallo K.Rola


Sub Save_as_Name_Date_and_Time2()
Dim myDate As String, myTime As String
Dim SaveString As String
Dim i As Integer
myDate = Format(Date, "dd.mm.yyyy")
myTime = Format(Now, "hh-mm-ss")
SaveString = Range("A1").Value
For i = 1 To Len(SaveString)
    Select Case Mid(SaveString, i, 1)
        Case "\", "/", ">", "<", ":", "*", "?", "[", "]", "¦"
            MsgBox ("Unerlaubtes Zeichen an Position " & i & " in " & """" & SaveString & """")
            Exit Sub
    End Select
Next i
ThisWorkbook.SaveAs Filename:="C:\" & Range("a1").Value & "_" & myDate & " " & myTime
End Sub


Gruss Rainer


Bild


Betrifft: Na bitte, geht doch...oT
von: K.Rola
Geschrieben am: 02.11.2003 15:08:16

oT


Bild


Betrifft: ... oder doch lieber luxuriös ;-))
von: Ramses
Geschrieben am: 02.11.2003 15:40:24

Hallo,

Nun ist aber Schluss ;-)


Sub Save_Workbook_as_Name_Date_and_Time()
'(C) by Ramses
'Speichert die aktuelle Mappe unter dem Namen in B1
'im Pfad aus A1 mit dem Zusatz Datum und Zeit
Dim myFso As Object
Dim myDate As String, myTime As String
Dim SaveString As String, myPath As String
Dim tmpPath As String, strTmp As String
Dim i As Integer, n As Integer, Qe As Integer
'FSO Object für die Folderprüfung
Set myFso = CreateObject("Scripting.FileSystemObject")
'Formatierung nötig um englische Datumsformate mit "/" auszuschliessen
myDate = Format(Date, "dd.mm.yyyy")
'Formatierung nötig, da in "Now" das unerlaubte Zeichen ":" vorkommt
myTime = Format(Now, "hh-mm-ss")
'Zelle woher der Pfad kommen soll
myPath = Range("A1").Value
'Prüfen ob der Pfad existiert
If myFso.folderexists(myPath) = False Then
    Qe = MsgBox("Der Pfad bzw. der Ordner existiert nicht !" & vbCrLf & "Soll er erstellt werden?", vbYesNo + vbCritical, "Dateifehler")
    If Qe = vbYes Then
        'Nicht existierenden Pfad erstellen
        n = 1
        tmpPath = myPath
        Do
            i = InStr(n, tmpPath, "\")
            If i > 0 Then
                strTmp = Left(tmpPath, i)
                n = i + 1
            Else
                strTmp = tmpPath
                n = Len(tmpPath)
            End If
            If Dir(strTmp, vbDirectory) = vbNullString Then
                MkDir strTmp
            End If
        Loop Until i = 0
    Else
        MsgBox ("Speichervorgang wegen Fehler in Pfadnamen abgebrochen !")
        Exit Sub
    End If
End If
'Prüfen ob letztes Zeichen ein Backslash ist
If Right(myPath, 1) <> "\" Then
    myPath = myPath & "\"
End If
'Zelle woher der Dateiname kommen soll
SaveString = Range("B1").Value
'Prüfen auf unerlaubte Zeichen im Dateinamen
For i = 1 To Len(SaveString)
    Select Case Mid(SaveString, i, 1)
        Case "\", "/", ">", "<", ":", "*", "?", "[", "]", "¦"
            MsgBox ("Unerlaubtes Zeichen """ & Mid(SaveString, i, 1) & """ an Position " & i & " in " _
                & """" & SaveString & """" & vbCrLf _
                    & vbCrLf & "Speichervorgang wegen Fehler in Dateinamen abgebrochen")
            Exit Sub
    End Select
Next i
'Speichern
ThisWorkbook.SaveAs Filename:=myPath & SaveString & "_" & myDate & " " & myTime & ".xls"
End Sub


Gruss Rainer


Bild


Betrifft: AW: ... oder doch lieber luxuriös ;-))
von: K.Rola
Geschrieben am: 02.11.2003 15:51:51

Hallo Ramses,

hast du schon wieder die geniale API:
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

vergessen?

Gruß K.Rola


Bild


Betrifft: Nein, nicht vergessen...
von: Ramses
Geschrieben am: 02.11.2003 16:02:25

Hallo K.rola

aber ich wollte Zeichen sparen;-))))

Deine Deklaration hat schon 105 Zeichen, Meine Deklaration incl. Prüfung und Ergebnis hat nur 10 Zeichen mehr *lol*

Gruss Rainer


Bild


Betrifft: AW: Nein, nicht vergessen...
von: K.Rola
Geschrieben am: 02.11.2003 16:09:05

Hallo, Ramses,

kann ich nicht nachvollziehen, bei mir sinds nur 104 Zeichen.

Gruß K.Rola


Bild


Betrifft: Akzeptiert....
von: Ramses
Geschrieben am: 02.11.2003 16:30:35

Hi

da ist beim kopieren aus der Seite wohl ein Zeilenumbruch mitgekommen ;-)

Gruss Rainer


Bild

Beiträge aus den Excel-Beispielen zum Thema " Datei mit Zell-Wert als Name speichern"