Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Datei speichern... | Herbers Excel-Forum


Betrifft: Datei speichern... von: edie
Geschrieben am: 18.01.2010 11:35:10

Hallo zusammen,

habe mir das nachfolgende Makro, durch die Recherche, zusammengestellt.

Dabei wird ein Ordner angelegt, wenn nicht vorhanden, und die Datei sollte
gespeichert werden.

Leider funktioniert das speichern nicht, und zwar keine von den 3 Optionen. Wo liegt der Fehler?

With ActiveWorkbook
1.
'.SaveAs strFolder
'2
' .SaveAs Filename:=strFolder & "\" & ActiveSheet.Range("K10") & "_" & ActiveSheet.Range("K12") & ".xls"
'3.
' .SaveAs Filename:=strFolder & "\" & sTemper & "_" & sDruck & ".xls"

End With

Hier das Makro:

Sub testlauf()
Dim strFolder As String
Dim sTemper As String
Dim sDruck As String
sTemper = Range("K10").Value
sDruck = Range("K12").Value

If ActiveSheet.Range("K10") = "" Then
MsgBox "Zelle K10 darf nicht leer sein"
Exit Sub
End If
If ActiveSheet.Range("K12") = "" Then
MsgBox "Zelle K12 darf nicht leer sein"
Exit Sub
End If

strFolder = ThisWorkbook.Path & "\Messwerte\" & sTemper & "_" & sDruck & ".xls"

If Dir(strFolder, vbDirectory) <> "" Then
Exit Sub
    Else
      If MsgBox("Das Verzeichnis existiert nicht, " & _
        vbLf & "neu anlegen ?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
End If

MkDir strFolder
  
With ActiveWorkbook
'.SaveAs strFolder
' .SaveAs Filename:=strFolder & "\" & ActiveSheet.Range("K10") & "_" & ActiveSheet.Range("K12")  _
& ".xls"
' .SaveAs Filename:=strFolder & "\" & sTemper & "_" & sDruck & ".xls"
End With
End Sub

Hat jemand eine Idee und kann helfen?

Vorab schon jetzt vielen Dank.

Grüße

  

Betrifft: AW: Datei speichern... von: MichaV
Geschrieben am: 18.01.2010 12:51:00

Hallo,

wäre schön gewesen wenn Du geschrieben hättest wo es den Fehler gibt.

Versuch mal diese kleine Änderung:

strFolder = ThisWorkbook.Path & "\Messwerte\"
strFilename = sTemper & "_" & sDruck & ".xls"

If Dir(strFolder, vbDirectory) <> "" Then
Exit Sub
Else
If MsgBox("Das Verzeichnis existiert nicht, " & _
vbLf & "neu anlegen ?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
End If

MkDir strFolder

With ActiveWorkbook
.SaveAs strFolder & strFilename


Gruss- Micha


  

Betrifft: AW: Datei speichern... von: edie
Geschrieben am: 18.01.2010 13:22:33

Hallo MichaV,

danke für die Hilfe, die Excel-Datei wird leider nicht im neu angelegten Ordner gespeichert,
sondern auf der gleichen Ebene wie der Ordner /Messwerte/.

Die Idee war wie Folgt: Im Ordner /Messwerte/ einen neuen Ordner anlegen, wenn noch
nicht vorhanden, mit dem Name aus Zelle K10. Danach die Excel-Datei in den neu erstellten
bzw. bereits vorhandenen (Name wie Zelle K10) zu speichern. Die Excel-Datei sollte dabei
den Name aus den Zellen K10 und K12 bekommen.

Hier mein angepasster Code:

Sub testlauf()
Dim strFolder As String
Dim sTemper As String
Dim sDruck As String
sTemper = Range("K10").Value
sDruck = Range("K12").Value

If ActiveSheet.Range("K10") = "" Then
MsgBox "Zelle K10 darf nicht leer sein"
Exit Sub
End If
If ActiveSheet.Range("K12") = "" Then
MsgBox "Zelle K12 darf nicht leer sein"
Exit Sub
End If

'strFolder = ThisWorkbook.Path & "\Messwerte\" & sTemper & "_" & sDruck & ".xls"
strFolder = ThisWorkbook.Path & "\Messwerte\" & sTemper  ""
strFilename = sTemper & "_" & sDruck & ".xls"

If Dir(strFolder, vbDirectory) <> "" Then
Exit Sub
    Else
      If MsgBox("Das Verzeichnis existiert nicht, " & _
        vbLf & "neu anlegen ?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
End If

MkDir strFolder
  
With ActiveWorkbook
.SaveAs strFolder & strFilename
End With
End Sub
Vielen Dank im Voraus.

Grüße


  

Betrifft: AW: Datei speichern... von: Armin
Geschrieben am: 18.01.2010 13:51:14

Hallo namenloser,
brauchst Du die Abfrage zwingend? Ansonsten kann man die auch weglassen.
Die "Dir" Funktion ist so falsch. Wenn Du nach einem Verzeichnis fragen willst, muss strFolder auch ein Verzeichnis beinhalten. Bei Dir incl. File.
So funktioniert der Code wenn Du nicht zwingend eine Abfrage benötigst.

Sub testlauf()
Dim strFolder As String
Dim sTemper As String
Dim sDruck As String
Dim StrPath As String
sTemper = Range("K10").Value
sDruck = Range("K12").Value


StrPath = ThisWorkbook.Path & "\Messwerte\" & sTemper
NeurOrdner (StrPath)
If Right(StrPath, 1) <> "\" Then StrPath = StrPath & "\"
strFolder = StrPath & "_" & sDruck & ".xls"


With ActiveWorkbook
.SaveAs strFolder
' .SaveAs Filename:=strFolder & "\" & ActiveSheet.Range("K10") & "_" & ActiveSheet.Range("K12")  _
_
& ".xls"
' .SaveAs Filename:=strFolder & "\" & sTemper & "_" & sDruck & ".xls"
End With
End Sub

Sub NeurOrdner(Ordner As String)
On Error Resume Next
MkDir Ordner
End Sub

LG Armin


  

Betrifft: AW: Datei speichern... von: edie
Geschrieben am: 18.01.2010 14:09:45

Hallo Armin,

eine Abfrage, ob der Ordner schon existiert wäre eine schöne Sache, zumal ich nicht
weiß im Vorhinein den Name das Ordners. Muss voll weiter testen. Mache mir aber
keine große Hoffnung.

Grüße-edie


  

Betrifft: AW: Datei speichern... von: edie
Geschrieben am: 18.01.2010 15:33:20

Hallo Armin,

so funktioniert es in Moment:

Sub testlauf()
Dim strFolder As String
strFolder = ThisWorkbook.Path & "\Messwerte\" & ActiveSheet.Range("K10")

If ActiveSheet.Range("K10") = "" Then
MsgBox "Zelle K10 darf nicht leer sein"
Exit Sub
End If
If ActiveSheet.Range("K12") = "" Then
MsgBox "Zelle K12 darf nicht leer sein"
Exit Sub
End If

Application.DisplayAlerts = False

With ActiveWorkbook
If Dir(strFolder, vbDirectory) = "" Then

MkDir strFolder
End If
.SaveAs Filename:=strFolder _
& "\" & ActiveSheet.Range("K10") & "_" & ActiveSheet.Range("K12") & ".xls"
.Close
End With
Application.DisplayAlerts = True
End Sub
Nur mal eine Frage: Weißt Du zufällig wie man z.B. ein Einzelblatt speichern kann?

Wäre schön, wenn man hier, nicht die ganze Excel-Datei sondern nur die "Tabbelle1" speichern könnte.


Vielen Dank für die Hilfe.

Grüße-edie


  

Betrifft: AW: Datei speichern... von: Armin
Geschrieben am: 19.01.2010 08:48:15

Hallo edie,
ja das weis ich. Aber da muss man natürlich erst etwas klären. Wann soll den das speichern erfolgen?
Nach welchem Event??? Oder Button oder oder. Also man kann "fasst alles" mit Excel realisieren.
Also am besten wäre es Du stellst eine Mustermappe zur Verfügung, da geht das erfahrungsgemäs am besten. Wenn Du die nicht ins Forum stellen willst kannst /willst, auch per Mail direkt.
War gestern leider nicht mehr online.
LG Armin


  

Betrifft: AW: Datei speichern... von: edie
Geschrieben am: 19.01.2010 09:12:31

Hallo Armin,

sehr nett von Dir, dass Du noch einmal im Thread nachgeschaut hast. Danke.
Ich habe kräftig recherchiert und rumgebastelt und das kam heraus:

Sub Tets() 'Speichern
Dim Pfad As String
Dim sPrüf As String
Dim DateiName As String
Dim wb As Workbook
Dim fn, vorgabe As String

Pfad = ThisWorkbook.Path & "\Messwerte\" & ActiveSheet.Range("K10")
sPrüf = Dir(Pfad, vbDirectory)
On Error GoTo errhandler

If sPrüf = "" Then
MkDir (Pfad)
End If

DateiName = Pfad & "\" & ActiveSheet.Range("K10") & "_" & ActiveSheet.Range("K12") & ".xls"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Sheets("Rohdaten").Range("A3:M25").Copy 'Bereich

Workbooks.Add

Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

With Columns
.AutoFit
End With

Application.GoTo reference:=Range("A2"), Scroll:=True

ActiveWorkbook.SaveAs (DateiName)
ActiveWorkbook.Close
MsgBox ("Die Daten wurden erfolgreich nach " & Pfad & " exportiert und unter dem Namen " & _
DateiName & " gespeichert!")
Exit Sub
errhandler:
MsgBox Err.Description, vbCritical, "Fehler " & Err.Number

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Eigentlich funktioniert es, aber zum Optimieren gibt es immer was.

Vielen Dank für die Geduld.

Grüße-edie


  

Betrifft: AW: Datei speichern... von: Armin
Geschrieben am: 19.01.2010 10:03:09

Hallo edie,
wenns klappt ist es ja ok. Es ist nicht so, dass ich zuviel Zeit habe.

LG Armin