Einen vorher zu bestimmenden Bereich in Outlook ei
11.09.2003 11:32:03
Martin
ich bin derzeit dabei mir ein Makro zu basteln, das den Inhalt eines bestimmten, vorher festzusetzenden Bereiches einer Tabelle in Outlook in ein Mail übertragen soll.
Würde ich eine einzelne Zelle ansprechen und diese in einer String Variablen speichern, klappt es problemlos. Bei einem aus mehreren Zellen bestehenden Bereich, bekomme ich es schon nicht mehr hin. Deshalb habe ich mit folgendes (zugegeben sehr umständliches Makro) zusammengestellt
Sub sendeMail()
Dim objOutlook As Object
Dim objMail As Object
Dim strTO As String
Dim strCC As String
Dim strSubj As String
Dim strA1 As String
Dim strA2 As String
Dim strA3 As String
Dim strA4 As String
Dim strA5 As String
Dim strB1 As String
Dim strB2 As String
Dim strB3 As String
Dim strB4 As String
Dim strB5 As String
Dim strC1 As String
Dim strC2 As String
Dim strC3 As String
Dim strC4 As String
Dim strC5 As String
Dim strD1 As String
Dim strD2 As String
Dim strD3 As String
Dim strD4 As String
Dim strD5 As String
Dim strBody As String
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
'Bereiche f Outlook definieren
If ThisWorkbook.Sheets(2).Range("A11").Value > "" Then strA1 = ThisWorkbook.Sheets(2).Range("A11")
If ThisWorkbook.Sheets(2).Range("A12").Value > "" Then strA2 = ThisWorkbook.Sheets(2).Range("A12")
If ThisWorkbook.Sheets(2).Range("A13").Value > "" Then strA3 = ThisWorkbook.Sheets(2).Range("A13")
If ThisWorkbook.Sheets(2).Range("A14").Value > "" Then strA4 = ThisWorkbook.Sheets(2).Range("A14")
If ThisWorkbook.Sheets(2).Range("A15").Value > "" Then strA5 = ThisWorkbook.Sheets(2).Range("A15")
If ThisWorkbook.Sheets(2).Range("B11").Value > "" Then strB1 = ThisWorkbook.Sheets(2).Range("B11")
If ThisWorkbook.Sheets(2).Range("B12").Value > "" Then strB2 = ThisWorkbook.Sheets(2).Range("B12")
If ThisWorkbook.Sheets(2).Range("B13").Value > "" Then strB3 = ThisWorkbook.Sheets(2).Range("B13")
If ThisWorkbook.Sheets(2).Range("B14").Value > "" Then strB4 = ThisWorkbook.Sheets(2).Range("B14")
If ThisWorkbook.Sheets(2).Range("B15").Value > "" Then strB5 = ThisWorkbook.Sheets(2).Range("B15")
If ThisWorkbook.Sheets(2).Range("G11").Value > "" Then strC1 = ThisWorkbook.Sheets(2).Range("G11")
If ThisWorkbook.Sheets(2).Range("G12").Value > "" Then strC2 = ThisWorkbook.Sheets(2).Range("G12")
If ThisWorkbook.Sheets(2).Range("G13").Value > "" Then strC3 = ThisWorkbook.Sheets(2).Range("G13")
If ThisWorkbook.Sheets(2).Range("G14").Value > "" Then strC4 = ThisWorkbook.Sheets(2).Range("G14")
If ThisWorkbook.Sheets(2).Range("G15").Value > "" Then strC5 = ThisWorkbook.Sheets(2).Range("G15")
If ThisWorkbook.Sheets(2).Range("J11").Value > "" Then strD1 = ThisWorkbook.Sheets(2).Range("J11")
If ThisWorkbook.Sheets(2).Range("J12").Value > "" Then strD2 = ThisWorkbook.Sheets(2).Range("J12")
If ThisWorkbook.Sheets(2).Range("J13").Value > "" Then strD3 = ThisWorkbook.Sheets(2).Range("J13")
If ThisWorkbook.Sheets(2).Range("J14").Value > "" Then strD4 = ThisWorkbook.Sheets(2).Range("J14")
If ThisWorkbook.Sheets(2).Range("J15").Value > "" Then strD5 = ThisWorkbook.Sheets(2).Range("J15")
strBody = strA1 & " " & strB1 & " " & strC1 & strD1 & Chr(13) & _
strA2 & " " & strB2 & " " & strC2 & strD2 & Chr(13) & _
strA3 & " " & strB3 & " " & strC3 & strD3 & Chr(13) & _
strA4 & " " & strB4 & " " & strC4 & strD4 & Chr(13) & _
strA5 & " " & strB5 & " " & strC5 & strD5
With objMail
.To = " "
'.cc = strCC
.Subject = "Test"
.Body = strBody
.Display
.ReadReceiptRequested = False
End With
Set objOutlook = Nothing
Set objMail = Nothing
End Sub
Das funktioniert. Allerdings werden Leerzeilen ins Mail eingefügt, wenn eben nichts in den Zellen steht. Der Umstand, dass ich jeweile 5 Variablensätze festgelegt habe ist willkürlich. Würden mehr Daten übertragen werden müssen, wären es entsprechend mehr. Mein Bereich muss dynamisch bleiben, da ich vorher nicht weiss, wieviele Zeilen vorhanden sind. Ind der Regel sind es so zwischen einer bis 3 Zeilen.
Ich habe mal einen Code gesehen, der einen markieten Bereich in die Zwischenablage kopiert und diese dann in Outlook einfügt. Dies ist für meine Anwendung leider nicht nutzbar, da auch Hintergrundfarben, Gitternetzlinien usw. mitkopiert werden.
Wie kann ich meinen Code vereinfachen?
Gruss,
Martin