Hallo Zusammen,
Ich benötige etwas Hilfe!
Es geht um ein Makro der anhand einer Liste als Excel Tabelle einige Mails erstellen muss. Jedoch bekomme ich nach der ersten iteration eine Fehlermeldung.
Die Excel wird automatisch erstellt von einer externen Bezugstelle. ich möchte nur das der Makro läuft sobald ich einen Button Klicke.
Der Ablauf soll wie folgt Ablaufen:
Der Makro überprüft erst mal die 2 & 3 Spalte ob ein User vorhanden ist. Dies geschieht in 2 unterschiedlichen IF Schleifen. Dabei checkt der Makro ob der String in den jeweiligen Zellen einen Punkt hat. Wenn dieser vorhanden ist wird der User in die Mail als adressant mit "@Mailadresse.de" hinzugefügt.
Nun zum Fehler:
Nach dem der Makro die erste Zeile erfolgreich geprüft hat, erhalte ich folgende Fehlermeldung:
"Laufzeitfehler '462': Der Remote-Server-Computer existiert nicht oder ist nicht verfügbar." zu der Zeile
"Vorlage.To = validrecipient1 & validrecipient2"
Wenn ich den Makro jedoch ohne folgenden Teil laufen lasse " Set ObjMail = CreateObject("Outlook.Application") Set Vorlage = ObjMail.CreateItemFromTemplate("D:\Bereich\Daten\Mailvorlage zu User vom TT. Monat Jahr.oft")" läuft das Programm problemlos durch.
Ich habe schon alle Verweise geprüft. Alle die notwendig sind sind Vorhanden. Weiter Anleitungen im Netz konnten den Fehler nicht beheben.
Hier ist der komplette code:
Public Sub GenerateMail()
'
'
'
Dim wb As Workbook
Dim ExcelApp As Object
Dim ExcelWorkbook As Object
Dim ExcelWorksheet As Object
Dim Path As String
Dim SavPath As String
Dim wbname As String
Dim sPath As String
Dim i As Integer
Dim lastRow As Long
Dim ObjMail As Object
Dim Vorlage As Object
Dim Result As String
Application.ScreenUpdating = False
Path = "D:\Bereich\Daten\"
SavPath = Format(Date, "YYYY") & "_" & Format(Date, "MM") & "\"
wbname = Format(Date, "YYYYMMDD") & "_User_" & Application.UserName & ".xlsx"
sPath = Path & SavPath
' Speicherpfad und Dateiname
Set wb = Workbooks.Open(Path & Format(Date, "YYYYMMDD") & "_User.xlsx")
wbname = Format(Date, "YYYYMMDD") & "_User_" & Application.UserName & ".xlsx"
'Findet raus bis welche Zeile der Makro läuft
lastRow = Cells(Rows.Count, 1).End(xlUp).row
'Loop zur erstellung einer Mail Pro Zeile
For i = 2 To lastRow
'Setzt Var für Mail und Vorlage fest
Set ObjMail = CreateObject("Outlook.Application")
Set Vorlage = ObjMail.CreateItemFromTemplate("D:\Bereich\Daten\Mailvorlage zu User vom TT. Monat Jahr.oft")
Vorlage.Subject = "User " & Cells(i, 1).Value & " vom " & Format(Date, "YYYYMMDD")
'Stellt E-Mail-Adressen zusammen
recipient1 = Cells(i, 3).Value
recipient2 = Cells(i, 4).Value
'Prüfung für Ersten Empfänger
If InStr(recipient1, ".") = 0 Then
A = MsgBox("ID " & Cells(i, 1).Value & "in Spalte 2 ist kein User", vbYesNo)
Else:
validrecipient1 = recipient1 & "@Mailadresse.de; "
End If
'Prüfung für Zweiter Empfänger
If InStr(recipient2, ".") = 0 Then
B = MsgBox("ID " & Cells(i, 1).Value & "in Spalte 3 ist kein User", vbYesNo)
Else:
validrecipient2 = recipient2 & "@Mailadresse.de; "
End If
'Absender festlegen und Mail anzeigen
Vorlage.To = validrecipient1 & validrecipient2
Vorlage.Display
Set ObjMail = Nothing
Next i
End Sub
Vielen Dank für eure Unterstützung!
MfG
Einer von vielen VBALaien
|