Folgenden Code habe ich mir aus verschiedenen Vorschlägen zusammengebastelt. Funktioniert auf meinem Privatrechner ca. 3 Sek bis sich Outlook meldet. Wenn ich ihn auf meinem Arbeitsrechner im Netzwerk laufen lasse, dauert es bis zu 6 Minuten bis Outlook aufgeht. Frage: Ist dieser Code fürs Netzwerk geeignet? oder ist da irgendwo eine Bremse drin? Oder liegt es einfach an einem langsamen Netzwerk? Bevor der Code gestartet wird blende ich mit einem zusätzlichen Code 6 Shapes aus und am Ende wieder ein. Hättet Ihr da eventuell einen Tip wie es schneller gehen könnte.
Gruß, Guesa
Sub einzelnes_Blatt_senden()
' Das aktive Tabellenblatt wird über Outlook versendet
' Dimensionierung der Variablen
'Application.ScreenUpdating = False
ActiveSheet.Name = ActiveSheet.Range("L1") 'Vergibt Tabellenname aus Zelle
Dim strBlatt As String
Dim strDatei As String
Dim strPfad As String
Dim outObj As Object
Dim Mail As Object
Dim strBodyText As String
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
'Pfad für temporäre Zwischenspeicherung angeben
strPfad = [F1].Value 'der Aktuelle Pfad
' Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
strBlatt = ActiveSheet.Name
' Gewähltes Tabellenblatt kopieren
Sheets(strBlatt).Copy
' Blatt temporär in vorgegebenes Verzeichnis abspeichern
ActiveWorkbook.SaveAs strPfad & "" & ActiveSheet.Name
' Pfad und Dateiname der neuen Datei zwischenspeichern
strDatei = ActiveWorkbook.FullName
' Body-Text festlegen
strBodyText = "Mit freundlichen Grüßen" & Chr(13) & Chr(13) & _
"" & Chr(13) & _
"" & Chr(13) & _
"" & Chr(13)
' Mail erzeugen
With Mail
.To = [G1].Value
'.CC = ""
.Subject = "" 'Betreff
.BodyFormat = 1 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.Body = strBodyText 'Bodytext / Signatur
End With
' Erzeugte Datei schließen
Workbooks(Dir(strDatei)).Close
' Erzeugte Datei wieder löschen
Kill (strDatei)
' E-Mail anzeigen
Mail.Display
Call einblenden
Application.ScreenUpdating = True
End Sub