Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
332to336
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
332to336
332to336
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datei mit Zell-Wert als Name speichern

Datei mit Zell-Wert als Name speichern
02.11.2003 13:12:10
Andi
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!

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datei mit Zell-Wert als Name speichern
02.11.2003 13:19:42
Ramses
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
AW: Datei mit Zell-Wert als Name speichern
02.11.2003 14:10:45
Andi
Hallo Ramses, das ging ja super schnell und einfach.

Herzlichen Dank!
AW: Datei mit Zell-Wert als Name speichern
02.11.2003 14:17:54
K.Rola
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
Anzeige
Dann aber richtig ....
02.11.2003 15:03:11
Ramses
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
Anzeige
Na bitte, geht doch...oT
02.11.2003 15:08:16
K.Rola
oT
... oder doch lieber luxuriös ;-))
02.11.2003 15:40:24
Ramses
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
Anzeige
AW: ... oder doch lieber luxuriös ;-))
02.11.2003 15:51:51
K.Rola
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
Nein, nicht vergessen...
02.11.2003 16:02:25
Ramses
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
AW: Nein, nicht vergessen...
02.11.2003 16:09:05
K.Rola
Hallo, Ramses,

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

Gruß K.Rola
Akzeptiert....
02.11.2003 16:30:35
Ramses
Hi

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

Gruss Rainer
Anzeige

317 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige