Laufzeitfehler 424: Objekt nicht definiert "- Beim Senden von E-Mails mit Outlook 2013

Question

Ich benutze unten Code, um mehrere E-Mails über Outlook zu senden, dieser Code funktioniert gut, wenn ich Excel 2007 und Outlook 2007 jedoch verwende, wenn ich versuchte, denselben auszuführen Code in Excel 2013 und Outlook 2013 es wirft einen Fehler "Runtime error 424: nicht Objekt definiert" im folgenden Code:

Set Doc = olMail.GetInspector.WordEditor 

Kann jemand bitte unter Codierung überprüfen und lassen sie mich wissen, was ich tun muss geändert werden, wenn ich dasselbe Makro in Version 2013 verwenden möchte?

Sub Msmail() 

Dim otlApp As Object 
Dim olMail As Object 


Set otlApp = CreateObject("Outlook.Application") 
Set olMail = otlApp.CreateItem(olMailItem) 

Set mainWB = ActiveWorkbook 

    Worksheets("Mail").Select 
    ActiveSheet.Calculate 

    Total_Site = Range("Total_Site") 
    For Site_Count = 1 To Total_Site 

    Application.StatusBar = False 
    ActiveSheet.Calculate 
    Range("Site_Count") = Site_Count 
    ActiveSheet.Calculate 

    If Range("Send_Email") = "Y" Then 

    Set mainWB = ActiveWorkbook 
    Set olMail = otlApp.CreateItem(olMailItem) 
    Set Doc = olMail.GetInspector.WordEditor '<~ ERROR 424 HERE 

    SendID = mainWB.Sheets("Mail").Range("To_List").Value 
    CCID = mainWB.Sheets("Mail").Range("Cc_List").Value 
    Subject = mainWB.Sheets("Mail").Range("Subject_Line").Value 
    Body = mainWB.Sheets("Summary").Range("Mail_Body").Value 
    AttachFile = mainWB.Sheets("Mail").Range("StrPath").Value 
    StrPath = ActiveSheet.Range("StrPath").Value 

    With olMail 

     .To = SendID 
     If CCID <> 0 Then 
      .CC = CCID 
     End If 
     .Subject = Subject 

     mainWB.Sheets("Summary").Range("Mail_Body").Copy 

     Set WrdRng = Doc.Range 
     .Display 
     WrdRng.Paste 

      'StrPath = Range("StrPath").Value 

      StrFile = Range("StrFile").Value & "*.*" 

      StrFile = Range("StrFile").Value 
      .Attachments.Add StrPath & "\" & StrFile 

      .Send 

    End With 
    End If 
    Next Site_Count 

End Sub 

Answer 1

OK - so scheint es eine Menge Probleme mit dem aktuellen Code zu geben; Sie haben doppelte Code und nicht-dimensionierte Variablen. Ich habe versucht, den Code zu komprimieren, fügte direkte Referenzen hinzu und dies wird hoffentlich besser lesbar und (sollte vielleicht) funktionieren, aber es ist noch nicht getestet ... Ich habe nicht die Bereiche in relevanten Tabellen und keine Daten zum Testen

es

Sub msMail() 

    Dim olApp As Object: Set olApp = CreateObject("Outlook.Application") 
    Dim olMail As Object 

    Dim Total_Site As Range, Doc As Variant, WrdRng As Range 
    Dim StrPath As String, StrFile As String, Site_Count As Long 

    Dim wbMain As Workbook: Set wbMain = ThisWorkbook 
    Dim wsMail As Worksheet: Set wsMail = wbMain.Worksheets("Mail") 
    Dim wsSumm As Worksheet: Set wsSumm = wbMain.Worksheets("Summary") 

    With wsMail 
     .Calculate ' Not sure why this is included... 
     Set Total_Site = Range("Total_Site") 
     For Site_Count = 1 To Total_Site.Count 
      ''Application.StatusBar = False 
      Range("Site_Count") = Site_Count 
      If Range("Send_Email") = "Y" Then 
       Set olMail = olApp.CreateItem(olMailItem) 
       Set Doc = olMail.GetInspector.WordEditor 
       If Not Doc Is Nothing Then 
        With olMail 
         .To = wsMail.Range("To_List") 
         .CC = IIf(wsMail.Range("Cc_List") <> 0, wsMail.Range("Cc_List"), "") 
         .Subject = wsMail.Range("Subject_Line") 
         wsSumm.Range("Mail_Body").Copy 
         Set WrdRng = Doc.Range 
         .Display 
         WrdRng.Paste 
         StrPath = wsMail.Range("StrPath") 
         StrFile = wsMail.Range("StrFile") 
         .Attachments.Add StrPath & "\" & StrFile 
         ' .Send 
        End With 
       End If 
      End If 
     Next Site_Count 
    End With 
End Sub