PDA

Vollständige Version anzeigen : Office Outlook Web Access statt MS Office Outlook


Matthias Kunz
28.04.2009, 20:25
Hallo zusammen!

Ich verwende unten stehenden Code, welcher mir eine Datei an bestimmte Empfänger sendet. Funktioniert perfekt!

Ich habe nur ein Problem; die Datei sollte über Office Outlook Web Access statt MS Office Outlook gesendet werden können. Wie kann ich den Code umschreiben?

Vielen, herzlichen Dank für eure Hilfe.


Beste Grüsse, Matthias

Private Sub CommandButton1_Click()

ActiveSheet.Unprotect

Range("A1").Select

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True


Sheets("Offertanfrage").Select
Sheets("Anfrage").Select




Dim objOutApp As Object 'Late Binding für Anwendung Ouztlook
Dim objOutMail As Object 'Late Binding für Mail in Outlook
Dim wsMail As Worksheet 'Tabelle mit den Versandangaben
Dim rngCell As Range 'Bezeichner zum Durchlaufen des Bereiches der Adressen
Dim strNewWbk As String 'Variable zur Aufnahme des Pfades und Namens der temporären Mappe

'Fehlerbehandlung: Sprungmarke zum Aufräumen
On Error GoTo err_here
'Ausschalten der Ereignisse von Excel sowie der Bildschirmaktualisierung
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

'Angabe der Tabelle mit den Mailadressen
Set wsMail = Sheets("Anfrage")

'Erstellen eines Zugriffes auf Outlook und Anmelden
Set objOutApp = CreateObject("Outlook.Application")
objOutApp.Session.Logon

'temporäre Mappe mit Tabelle2 wird im gleichen Verzeichnis nur für den Versand angelegt
strNewWbk = ThisWorkbook.Path & Application.PathSeparator & _
"Offertanfrage vom " & Format(Date, "YYMMDD") & ".xls"
Worksheets("Offertanfrage").Copy
'Speichern der Mappe
ActiveWorkbook.SaveAs strNewWbk
'Schließen der Mappe
ActiveWorkbook.Close savechanges:=False

'Durchlaufen der Werte in Spalte A der Tabelle mit den Mailadressen
For Each rngCell In wsMail.Columns("A").Cells.SpecialCells(xlCellTypeConstants)
'Prüfung, ob eine Mailadresse vorliegt
If rngCell.Value Like "?*@?*.?*" Then
'Erstellen einer neuen Mail in Outlook
Set objOutMail = objOutApp.CreateItem(0)

With objOutMail
'Zuweisen des Empfängers
.To = rngCell.Value
'Zuweisen des Betreffs aus Zelle
.Subject = Range("G1").Value
'Zuweisen des Textkörpers
.Body = Range("G2").Value
'Anhängen der temporären Mappe
.Attachments.Add strNewWbk
'Display zeigt die Mail in Outlook an, .Send verschickt sie

'Bei Verwendung von .Send erfolgt die Mitteilung auf exzernen Zugriff auf Outlook,
'die bestätigt werden muss. Grenze hier bei .Send auf 1 Minute einstellen
.send
End With

'Mailobjekt kann aufgelöst werden
Set objOutMail = Nothing
End If
'nächste Zelle in Spalte A
Next rngCell

'Aufräumarbeiten, auch im Fehlerfall
err_here:
'Zugriff auf Outlook beenden
Set objOutApp = Nothing
'Tabelle freigeben
Set wsMail = Nothing


Application.Run "'Offertanfrage SV Schweiz.xls'!Makro1"



ThisWorkbook.Saved = True
Application.Quit


End Sub

Matthias Kunz
04.05.2009, 19:47
Hallo nochmals!

Kann mir wirklich niemand einen Tipp für die Lösung meines Problems geben?

Wäre sehr, sehr dankbar!



Beste Grüsse, Matthias