Wenn du das mit der Abfrage für die Zeile machst musst du als erstes statt mit Range mit Cells arbeiten. Der Befehl Cells ist folgendermaßen aufgebaut. Cells(Zeile,Spalte)
Probier mal, ob es funktioniert, sonst muss die die Cells noch bisschen an deine Tabelle anpassen.
Hab probiert, bei mir funktioniert es jetzt.
Sub Senden()
Dim zeile As Integer
zeile = InputBox("GEben Sie ihre Spalte an")
On Error Resume Next
Dim olApp As Object
Dim strhtml As String
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
strhtml = Range("A2").Value & " <br><br>" & "<br>"
strhtml = strhtml & "Info: " & "<br>" & Cells(zeile,13) & " <br>"
strhtml = strhtml & "Artikelnummer: " & Cells(zeile, 1) & " <br>" & "<br>"
strhtml = strhtml & "Bezeichnung: " & Cells(zeile, 2) & " <br>" & "<br>"
strhtml = strhtml & "Seriennummer: " & Cells(zeile, 3).Value & " <br>" & "<br>"
strhtml = strhtml & "Besondere Merkmale: " & Cells(zeile, 4).Value & " <br>" & "<br>"
strhtml = strhtml & "Geliefert an: " & Cells(zeile, 5) & " <br>" & "<br>"
strhtml = strhtml & "Geliefert am: " & Cells(zeile, 6) & " <br>" & "<br>"
strhtml = strhtml & "Aufgestellt bei: " & Cells(zeile, 7) & " <br>" & "<br>"
strhtml = strhtml & "Aufgestellt am: " & Cells(zeile, 8) & " <br>" & "<br>"
strhtml = strhtml & "Link zu Protokoll/Info: " & Cells(zeile, 9) & " <br>" & "<br>"
strhtml = strhtml & "Angelegt von: " & Cells(zeile,10) & " <br>" & "<br>"
strhtml = strhtml & "Bemerkung: " & Cells(zeile,11) & " <br>" & "<br>"
strhtml = strhtml & ""
strhtml = strhtml & ""
.to = "" 'Empfänger
.Subject = "Seriennummerinformation"
' .cc = "kopie@an.de" 'Optional Kopie an
' .bcc = "bliendkopie@an.de" 'Optional Bliendkopie
.htmlbody = strhtml
.display 'Zeigt die Mail an
' .send 'Optional Mail sofort senden.
End With
Set olApp = Nothing
End Sub
|