Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 10:38:52
Bedingte Formatierung per VBA / MaxPoint
25.04.2024 10:30:04
Suche mit MINWENNS und Rückgabe mehrerer Werte
25.04.2024 09:47:49
Daten aus mehreren Dateien untereinander importieren
25.04.2024 09:31:31
Bild "In Zelle platzieren"
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1856to1860
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1856to1860
1856to1860
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Fehlermeldung

Fehlermeldung
18.11.2021 07:15:40
Daniel
Guten Morgen zusammen
Endlich habe ich gefunden was ich gesucht habe. Mein Code funktioniert soweit wie gewünscht. Ich löse den Code über eine UF mit einem CommandButton aus. Starte ich die UF und klicke den Button zum ersten mal, so funktioniert alles wie gewünscht.
Klicke ich den Butten ein zweites mal, erscheint die Fehlermeldung "Laufzeitfehler 462 Der Remote-Server-Computer existiert nicht oder ist nicht verfügbar" bei der Zeile

ActiveDocument.SaveAs strFileName, wdFormatHTML, , , , , , , SaveNativePictureFormat:=True
Sieht jemand den Fehler oder hat jemand eine andere Lösung?
Besten Dank für Eure Hilfe und einen schönen Tag.

Sub Word001()
Dim ObjWinWord As Object
Dim ObjDocWord As Object
Dim strSuchbegriff_Anfang As String
Dim strSuchbegriff_Ende As String
Dim strTextInDoc As String
Dim strTextGefunden As String
Const wdWindowStateMaximize As Long = 1
'Suchbegriffe für Anfang und Ende vorgeben!
strSuchbegriff_Anfang = "Hallo da draussen!"
strSuchbegriff_Ende = "Freundliche Grüsse"
Set ObjWinWord = CreateObject("Word.Application")
ObjWinWord.Visible = True
ObjWinWord.WindowState = wdWindowStateMaximize
ObjWinWord.Activate
Set ObjDocWord = ObjWinWord.Documents.Open("C:\Users\User\Dropbox\VBA\E-mail\Text001.docx")
'    Set ObjDocWord = ObjWinWord.Documents.Open("C:\Users\Nathi Noel Dänu\Dropbox\VBA\E-mail\Text001.docx")
strTextInDoc = ObjDocWord.Content.Text
strTextGefunden = Trim$(Split(Split(strTextInDoc, strSuchbegriff_Anfang)(1), strSuchbegriff_Ende)(0))
' neues word Dokument erstellen
ObjWinWord.Documents.Add
With ObjWinWord
.Visible = True
.WindowState = 1
.Activate
.Selection.TypeText Text:=strTextGefunden
End With
' Word Dokument als HTML umwandeln
Dim strFileName As String
Dim TextToHTML As String
strFileName = Environ$("Temp") & "/" & Format(Now, "HTML_Test") & ".html"
ActiveDocument.SaveAs strFileName, wdFormatHTML, , , , , , , SaveNativePictureFormat:=True
TextToHTML = CreateObject("Scripting.FileSystemObject").GetFile(strFileName).OpenAsTextStream(1, -2).ReadAll
ActiveDocument.Close
Kill strFileName
ObjWinWord.Quit
Set ObjWinWord = Nothing
'E-Mail erstellen
Dim MyOutApp As Object
Dim MyMessage As Object
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.bodyformat = 2
.GetInspector
.To = "deinname@deinedomain.de"
.Subject = "Pneu & Rad Tage"
.HTMLBody = TextToHTML & .HTMLBody
.Display
' .Send        'Sendet die Email automatisch
End With
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fehlermeldung
18.11.2021 08:40:40
Luschi
Hallo Daniel,
ich wundere mich, daß der Code überhaupt läuft, denn es fehlt diese Definition:
Const wdFormatHTML As Long = 8
Gegen solche Störungen hilft folgender Eintrag am Beginn jedes Moduls:
Option Explicit
Gruß von Luschi
aus klein-Paris
PS: oder Du vermischt 'early bindig' (externer Verweis) mit 'late bindig' (CreateObject) und das geht selten gut!
AW: Fehlermeldung
18.11.2021 12:29:13
Daniel
Hallo Luschi
Vielen Dank für Deine Rückmeldung. Das Option Explicit habe ich schon geschrieben. Das Const wdFormatHTML As Long = 8 habe ich ebenfalls eingefügt. Weis zwar nicht genau ob ich es am richtigen Ort eingefügt habe? Aber leider bekomme ich immer noch der gleiche Fehler!
Gruss Daniel E.
Anzeige
AW: Fehlermeldung
19.11.2021 20:41:37
Yal
Hallo Daniel,
ziemlich verkompliziert. Der Outlook-Editor ist nicht anderes als eine Word-Document (mehr oider weniger). Der Umweg über html ist unnötig.
aus https://stackoverflow.com/questions/35609112/how-to-send-a-word-document-as-body-of-an-email-with-vba 

Sub emailFromDoc()
Dim wd As Object, editor As Object
Dim doc As Object
Dim oMail As MailItem
Set wd = CreateObject("Word.Application")
Set doc = wd.documents.Open(...path to your doc...)
doc.Content.Copy
doc.Close
set wd = Nothing
Set oMail = Application.CreateItem(olMailItem)
With oMail
.BodyFormat = olFormatRichText
Set editor = .GetInspector.WordEditor
editor.Content.Paste
.Display
End With
End Sub
Wenn Du es schafft deinen Kollegen zu überzeugen, in das Dokument nicht mehr als was zwischen "Hallo ..." und "Freundliche Grüsse" zu speichern, ist der Code die vollständige Lösung.
Wenn die Begriff doch gesucht werden sollten...

Sub emailFromDoc()
Dim wd As Word.Application 'Unter Verweis auf Microsoft Word 16.0 Object Library (Falls nicht in Word)
Dim editor As Outlook.Inspector 'Unter Verweis auf Microsoft Outlook 16.0 Object Library (Falls nicht in Outlook)
Dim Doc As Object
Dim oMail As MailItem
Dim rng1 As Word.Range
Dim rng2 As Word.Range
Const strAnfang = "Hallo da draussen!"
Const strEnde = "Freundliche Grüsse"
Set wd = New Word.Application 'CreateObject("Word.Application")
Set doc = wd.documents.Open(...path to your doc...)
Set rng1 = Range_finden(Doc.Range, strAnfang)
Set rng2 = Range_finden(Doc.Range(rng1.Range, Doc.Range.End), strEnde)
If rng1 Is Nothing Or rng2 Is Nothing Then
MsgBox "Entweder """ & strAnfang & """ und/oder "" " & strEnde & """ wurde(n) nicht gefudnen."
Exit Sub
End If
Doc.Range(rng1.Start, rng2.End).Copy
Doc.Close
Set wd = Nothing
Set oMail = Application.CreateItem(olMailItem)
With oMail
.BodyFormat = olFormatRichText
Set editor = .GetInspector.WordEditor
editor.Content.Paste
.Display
End With
End Sub
Function Range_finden(Rng As Word.Range, ByVal SuchText As String) As Word.Range
If Rng.Find.Execute(FindText:=SuchText) Then Set Range_finden = Rng
End Function
Ungetestet.
VG
Yal
Anzeige

Links zu Excel-Dialogen

CommandButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige