Mein Problem ist, daß folgendes macro im F8 - Modus alles genau nach Wunsch speichert, jedoch bei Klick auf das CommandButton1 nur unter C:\Eigene Dateien\ und ohne die Erweiterung "Regiestundenaufstellung" speichert.
Villeicht könnt Ihr mir helfen.
VG Alfred
Private Sub CommandButton1_Click()
'
'
On Error GoTo Err_Datei_Save_Click
'
'
'
Dim Name1 As String, Name2 As String, Name3 As String, Name4 As String, Name5 As String
Dim D_Name As String, D_Pfad As String, H_String As String
Dim i As Integer
Dim Schon_da As Boolean
Name1 = "C:\Documents and Settings\HOCHBAU2\Eigene Dateien\4 TECHNISCHE ABWICKLUNG - ak\04 04 Bauabwicklung\04 04 05 Regieberichte, Materialien\"
Name2 = Range("A2") 'Jahresverzeichnis "Jahr"
Name3 = Range("A3") 'Verzeichnis "Macro" (zur Probe)
Name4 = Range("A1") 'Dateiname "Datum + Seite"
Name5 = " - Regiestundenaufstellung.xls" 'Erweiterung
D_Pfad = Name1 + Name2 + Name3 'Pfadangabe
'D_Name = Name4 + Name5 'Dateiname und Erweiterung
'
Schon_da = False
'
'Abfragen, ob überhaupt ein Datum eingegeben wurde
'oder was da in "A1" ist
If IsNull(Range("A1")) Or Trim(Range("A1")) = "" Then
MsgBox "Sie haben kein Speicherdatum auf E1 eingegeben!"
GoTo Exit_Datei_Save_Click
Else
D_Name = Name4 + Name5
End If
End If
D_Name = D_Pfad + D_Name
'
With Application.FileSearch 'alle relevanten Files
.LookIn = D_Pfad 'in dem Pfad
.FileType = msoFileTypeExcelWorkbooks.Execute
End With
'
With Application.FileSearch
For i = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
If Trim(.FoundFiles(i)) = D_Name Then 'Datei schon vorhanden?
Schon_da = True
End If
Next i
End With
'
If Schon_da Then
H_String = "Soll die vorhandene Datei ersetzt werden?"
i = MsgBox(H_String, vbYesNo, "Speichern..")
If i = 6 Then ' ja überschreiben
ActiveWorkbook.Save
MsgBox "Datei wurde ersetzt"
Else
GoTo Exit_Datei_Save_Click
End If
Else
ActiveWorkbook.SaveAs Filename:=D_Name
MsgBox "Datei wurde gespeichert"
End If
'
'
Exit_Datei_Save_Click:
Exit Sub
'
Err_Datei_Save_Click:
MsgBox Err.Description
Resume Exit_Datei_Save_Click
'
End Sub