Problem mit Übergabe Outlook
02.05.2008 11:47:00
Marcus
Werbematerialbestellung
In Tabelle 1 wird ausgewählt Was bestellt wird und wieviel
Per Knopfdruck zieht er die Bestellungen von einer Bestandsliste ab und kopiert die Werte in eine Outlook Mail, die ich dann noch bearbeiten kann und verschicken kann.
Habe jetzt noch hinzugefügt das er danch die ausgefüllten Zellen (ist ein bestimmter Bereich) wieder leeren soll und das Dokument schließen und abspeichern soll.
Rufe momentan das Schließen nicht auf da er vorne schon ein Problem hat und zwar übergibt er die Daten (ausser Mailadresse und Betreff) nicht mehr ins Outlook, habe schon mit Sleep experimentiert, sowohl an der Stelle wo es jetzt steht und vor Call Zellenleeren. Leider keinen Erfolg, er macht immer das Outlook auf übergibt Mailadresse und Betreff und löscht dann nur die Zellen.
Hier der Code
Dim MyBestellung As String
Private Sub CommandButton1_Click()
Dim Bereich As Long, Such As Range
For Bereich = 4 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(Bereich, 2).Value > "" Then
With Tabelle2
Set Such = .Range("B:B").Find(What:=Cells(Bereich, 2).Value, LookIn:=xlValues, LookAt:=xlWhole) _
_
If Not Such Is Nothing And IsNumeric(Cells(Bereich, 3).Value) Then
Such.Offset(0, 1) = CLng(Such.Offset(0, 1)) - CLng(Cells(Bereich, 3).Value)
End If
End With
End If
Next Bereich
Set Such = Nothing
Call MailSenden
End Sub
Sub MailSenden()
Dim MyOutApp As Object, MyMessage As Object
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = "test@tester.de"
.Subject = "Bestellung Werbematerialien"
.Display
End With
ActiveSheet.Range("A1:" & Cells(Rows.Count, 3).End(xlUp).Address).Copy
Sleep (50)
Application.SendKeys ("%bi")
Set MyOutApp = Nothing
Set MyMessage = Nothing
Call Zellenleeren
End Sub
Sub Zellenleeren()
Range("B3:C28").ClearContents
End Sub
Sub Schliessen()
Workbooks("Werbematerial.xls").Close SaveChanges:=True
End Sub