Microsoft Excel

Herbers Excel/VBA-Archiv

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

speichernproblem

Betrifft: speichernproblem
von: ak
Geschrieben am: 13.04.2003 - 09:59:37

Hi!
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

  

Re: speichernproblem
von: Forum
Geschrieben am: 13.04.2003 - 10:06:32

Hallo Ak

lasse mal das Makro Debuggen, dann wird er sofort Mecker das ein End if zu viel, bei 2x End If hintereinander

den Befehl "msoFileTypeExcelWorkbooks" kennt Excel XP nicht

Gruß Hajo
Der Code wurde getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.
Microsoft MVP für Excel

  

Re: speichernproblem
von: ak
Geschrieben am: 13.04.2003 - 10:27:30

Muß ich gleich probieren.
Das zweite EndIf dürfte sich beim kopieren ergeben haben.
Vielen Dank

und VG

Alfred