Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1040to1044
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
Inhaltsverzeichnis

Wird nicht in richtigen Ordner gespeichert

Wird nicht in richtigen Ordner gespeichert
22.01.2009 10:34:42
Becker
Hallo Excel Profis
Habe ein kleines Problem mit Speichern.
Habe einen Ordner "Test" auf Memory Stick.
In dieser Ordner ist die Mappe "Work.xlsm" gespeichert wo sich der Macro "SicherungAnlegen" befindet.
Dieser Macro sichert mir Work.xlsm" ins Neue Mappe als /Format(Now, "DD-MM-YY_hh-mm-ss") & ".xlsx"/.
Zur Problemm. Ich habe mit diesen Befehl gedacht;
/ActiveWorkbook.SaveAs .Path & "\BackUp2009" & Format(Now, "DD-MM-YY_hh-mm-ss") & ".xlsx"/
es solle die Mappe "BackUp2009........xlsx" in unter Odner "BackUp2009" gespeichert werden.
Der unter Ordner befindet sich in "Test" Ordner auf den Memory Stick.
Wie konnte man immer eine Sicherungs Kopie in den vorgegebenen"BackUp2009" Unterodner auf den Memory Stick haben und nicht in den Ordner wo sich die Mappe "Work.xlsm" befindet.?
Da ich auf verschiedenen PCs arbeite hat die Memory Stick immer andere Buchstabe und von da her kann man nicht feste Buchstabe für den Memory Sick vergeben.
Hat jemand von Euch eine Idee dazu?
Ich wäre für helfende Hinweise sehr dankbar.
Netten Gruß Daniel

Sub SicherungAnlegen()
Dim Datei As Workbook, meTab As Worksheet, lngZahl As Long
Const Pfad As String = "C:\"
Application.ScreenUpdating = False
For Each meTab In ThisWorkbook.Sheets
If meTab.Visible = True Then
lngZahl = lngZahl + 1
If lngZahl = 1 Then
meTab.Copy
Set Datei = ActiveWorkbook
Else
meTab.Copy After:=Datei.Sheets(Datei.Sheets.Count)
End If
End If
Next meTab
Application.DisplayAlerts = False
With ThisWorkbook
ActiveWorkbook.SaveAs .Path & "\BackUp2009" & Format(Now, "DD-MM-YY_hh-mm-ss") & ".xlsx"
End With
Application.DisplayAlerts = True
Datei.Close
ThisWorkbook.Save
Application.ScreenUpdating = True
Set Datei = Nothing
End Sub


3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Wird nicht in richtigen Ordner gespeichert
22.01.2009 11:24:00
Tino
Hallo,
versuche es mal so.

Sub SicherungAnlegen()
Dim Datei As Workbook, meTab As Worksheet, lngZahl As Long
Dim sPfad As String
Dim mySheets() As String
Const Pfad As String = "C:\"
With Application
.ScreenUpdating = False
.DisplayAlerts = False
For Each meTab In ThisWorkbook.Sheets
If meTab.Visible = True Then
ReDim Preserve mySheets(lngZahl)
mySheets(lngZahl) = meTab.Name
lngZahl = lngZahl + 1
End If
Next meTab
Sheets(mySheets).Copy
Set Datei = ActiveWorkbook
With ThisWorkbook
sPfad = IIf(Right$(.Path, 1) = "\", .Path, .Path & "\") & "BackUp2009\"
ActiveWorkbook.SaveAs sPfad & _
Format(Now, "DD-MM-YY_hh-mm-ss") & ".xlsx"
End With
Datei.Close
ThisWorkbook.Save
.DisplayAlerts = True
.ScreenUpdating = True
End With
Set Datei = Nothing
End Sub


Gruß Tino

Anzeige
AW: Wird nicht in richtigen Ordner gespeichert
22.01.2009 12:34:56
Becker
Hallo Tino,
vielen, vielen, vieln Dank für meisterhafte Lösung.
Deine Lösung ist GGEEENNIIIAALLLLL!!!!!!
DANKE
AW: Wird nicht in richtigen Ordner gespeichert
22.01.2009 12:57:44
Tino
Hallo,
Du kannst auch noch eine Prüfung einbauen,
die überprüft ob der Ordner für dieses Jahr vorhanden ist und gegebenenfalls diesen anlegt.

Option Explicit
Sub SicherungAnlegen()
Dim Datei As Workbook, meTab As Worksheet, lngZahl As Long
Dim sPfad As String
Dim mySheets() As String
Const Pfad As String = "C:\"
With Application
.ScreenUpdating = False
.DisplayAlerts = False
For Each meTab In ThisWorkbook.Sheets
If meTab.Visible = True Then
ReDim Preserve mySheets(lngZahl)
mySheets(lngZahl) = meTab.Name
lngZahl = lngZahl + 1
End If
Next meTab
Sheets(mySheets).Copy
Set Datei = ActiveWorkbook
With ThisWorkbook
sPfad = IIf(Right$(.Path, 1) = "\", .Path, .Path & "\") & "BackUp" & Year(Date) & "\"
If Dir(sPfad, vbDirectory) = "" Then 'ist Ordner vorhanden?
MkDir sPfad 'Ordner anlegen
End If
ActiveWorkbook.SaveAs sPfad & _
Format(Now, "DD-MM-YY_hh-mm-ss") & ".xlsx"
End With
Datei.Close
ThisWorkbook.Save
.DisplayAlerts = True
.ScreenUpdating = True
End With
Set Datei = Nothing
End Sub


Gruß Tino

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige