Outlook öffnen - E-Mail Adresse in Zelle

Hallo Forum,
meine Tabelle bezieht aus einer Access Datenbank (in Access als Hyperlink formatiert) in die Zelle "BE12" eine E-Mail Adresse und in "BE13" eine Web Adresse.
Nun möchte ich gern, jeweils einen Schaltbutton erstellen, der entsprechend Outlook oder Internet Explorer öffnet.
Ich hab schon in Google einiges gefunden, komme aber einfach mit der Anpassung nicht klar.
Vielen Dank für eure Anregungen
Hans
Option Explicit
Private Sub CommandButton1_Click()
Dim olApp As Object, olMailItm As Object, i, lz, k As Integer, Pfad As String
Pfad = "C:\Test\" 'Hier Pfad anpassen
lz = Cells(Rows.Count, 1).End(xlUp).Row
i = 2
weiter:
Do Until i > lz
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)
Cells(i, 1).Select
If ActiveCell.Value <> "" Then
With olMailItm
.To = Cells(i, 1).Value
.Subject = Cells(i, 2).Value
.Body = _
"Hallo " & Cells(i, 3).Value & "," & _
Chr(13) & _
Chr(13) & _
"Hierk kommt der Text" & Cells(i, 5).Value & _
Chr(13) & _
Chr(13) & _
"Hier kommt die Info" & Cells(i, 6).Value & _
Chr(13) & _
Chr(13) & _
Chr(13) & _
"Mit freundlichen Grüßen" & _
Chr(13) & _
Chr(13) & _
Chr(13)
.ReadReceiptRequested = True
If Dir(Pfad & Cells(i, 4).Value) <> "" Then 'Abfrage ob Anhang vorhanden
.Attachments.Add Pfad & Cells(i, 4).Value
End If
.Display 'alternativ ".Send" für direktes Versenden
End With
Else

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub mail() Dim OL As Object ' Outlook.Application Dim OLApp As Object ' Outlook.AppointmentItem Set OL = CreateObject("Outlook.Application") Set OLApp = OL.CreateItem(0) With OLApp .Subject = "Neue Nachriten von uns" .Body = "Hallo wir haben gute Nachrichte für Sie:" .display End With Set OLApp = Nothing Set OLApp = Nothing End Sub

Hallo Hans,

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub mail()
Dim OLApp As Object ' Outlook.Application
Dim OLMail As Object ' Outlook.AppointmentItem
Dim strTo As String

With Sheets("Tabelle1") 'Tabelenname anpassen!
  If IsValidMailAddress(.Range("BE12")) Then
    strTo = .Range("BE12")
  Else
    MsgBox "Keine Mailadresse vorhanden!"
    Exit Sub
  End If
End With

Set OLApp = CreateObject("Outlook.Application")
Set OLMail = OLApp.CreateItem(0)

With OLMail
  .Subject = "Neue Nachriten von uns"
  .Body = "Hallo wir haben gute Nachrichte für Sie:"
  .To = strTo
  .display
End With


Set OLApp = Nothing
Set OLMail = Nothing
End Sub

Private Function IsValidMailAddress(ByVal strAddress As String) As Boolean
Dim oRegExp As Object
Set oRegExp = CreateObject("vbscript.regexp")

With oRegExp
  .Pattern = "[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|" & _
    "}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:" & _
    "[a-z0-9-]*[a-z0-9])?"
  
  .IgnoreCase = True
  
  IsValidMailAddress = .test(strAddress)
End With

Set oRegExp = Nothing

End Function

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Outlook öffnen - E-Mail Adresse in Zelle

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

312 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Outlook öffnen - E-Mail Adresse in Zelle

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

312 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread