Problem mit Datei versenden
17.01.2005 14:20:38
Thomas
ich habe folgendes Problem:
per makro wird ein Tabellenblatt in eine neue Datei kopiert. Der Dialog "speichern unter" wird aufgerufen, wobei die neue Datei bereits mit dem Speichernamen eingetragen wird. Anschließend soll diese Datei mit dem zugewiesenen Namen per Outlook versand werden.
Das klappt auch alles wunderbar. Nur wenn das Speichern abgebrochen wird, kommt beim Versuch, die Datei per Outlook zu verschicken eine Fehlermeldung. Dies ist auch logisch, denn die Datei erhält ihren Namen ja erst beim speichern.
Kann mir jemand helfen, wie ich die Datei trotz speicherabbruch mit ihrem neuen Namen versenden kann?
Hier der Ausschnitt aus dem Code:
'aktives Tabellenblatt in ein neues Workbook kopieren
ActiveSheet.Select
ActiveSheet.Copy
'Formeln durch Werte ersetzen
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveSheet.Shapes("Button 1").Select
Selection.Cut
Range("A1").Select
'Zusammensetzen des Speichernamens
sname = [IK1] & "_" & [Status1] & "_" & [Jahr1] & ".xls"
StrFileSaveName = sname
Call speichern
Call Excel_Workbook_via_Outlook_Senden
ActiveWorkbook.Close
End Sub
Sub speichern()
'ruft den Dialog "Speichern unter" auf mit dem vorgeschlagenen Dateinamen
StrFileSaveName = Application.GetSaveAsFilename(sname)
If StrFileSaveName <> False Then
ActiveWorkbook.SaveAs (StrFileSaveName)
End If
End Sub
Sub Excel_Workbook_via_Outlook_Senden()
Dim Nachricht As Object, OutApp As Object
'Ermittlung Emailempfänger
empfänger = ThisWorkbook.Sheets("emailtext").Range("A1").Value
Set OutApp = CreateObject("Outlook.Application")
'InitializeOutlook = True
'Emailtext wird der Variablen "mailtext" zugeordnet
mailtext = ThisWorkbook.Sheets("emailtext").Range("A4").Value & Chr(13)
Set Nachricht = OutApp.CreateItem(0)
'empfänger = Sheets("emailtext").Range("A1").Value
With Nachricht
.To = empfänger
'Betreff
.Subject = "Simtool " & sname & Date & Time
.attachments.Add StrFileSaveName
'Emailtext
.Body = mailtext
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'Mail.Send
End With
'OutApp.Quit (schließt outlook wieder)
Set OutApp = Nothing
Set Nachricht = Nothing
End Sub
Danke und Gruß
Thomas