Excel in Word-Datei, diese speichern und an Verteiler senden VBA
Hallo zusammen,
ich bin neu hier, absoluter Laie in Sachen VBA und hoffe hier Hilfe zu bekommen.
Hier mein Problem
Ich habe eine Liste in Excel aus der ich die Daten aus der markierten Zeile per VBA in eine vorhandene Word-Vorlage übertrage.
Vorgang:
- Daten in Excel eintragen
- Zeile markieren
- Butten klicken
- Word wird geöffnet und die Daten sind vorhanden
Aktueller Stand ist dass die Wordvorlage unter dem Namen Dokument1 neu geöffnet wird und die richtigen Daten stehen an den richtigen Textmarken im Word.
Soweit so gut, jetzt würde ich aber gern diese Datei in einem vorgegebenen Ordner unter dem Namen "Laufende Nummer_YYYY_MM_DD_hh_mm" abspeichern und anschließend per Outlook an einen vorgegebenen Verteiler schicken. Im Betreff soll ein vorgegebener Text und die Daten aus vier Zellen der markierten Zeile stehen und im Text der eMail ebenso.
Ich hoffe die laienhafte Beschreibung ist verständlich und hoffe auf den ein oder anderen Tip, würde mich riesig freuen.
Grüße und vorab vielen Dank an alle,
Markus
Anbei noch der Code der soweit auch funktioniert:
ich bin neu hier, absoluter Laie in Sachen VBA und hoffe hier Hilfe zu bekommen.
Hier mein Problem
Ich habe eine Liste in Excel aus der ich die Daten aus der markierten Zeile per VBA in eine vorhandene Word-Vorlage übertrage.
Vorgang:
- Daten in Excel eintragen
- Zeile markieren
- Butten klicken
- Word wird geöffnet und die Daten sind vorhanden
Aktueller Stand ist dass die Wordvorlage unter dem Namen Dokument1 neu geöffnet wird und die richtigen Daten stehen an den richtigen Textmarken im Word.
Soweit so gut, jetzt würde ich aber gern diese Datei in einem vorgegebenen Ordner unter dem Namen "Laufende Nummer_YYYY_MM_DD_hh_mm" abspeichern und anschließend per Outlook an einen vorgegebenen Verteiler schicken. Im Betreff soll ein vorgegebener Text und die Daten aus vier Zellen der markierten Zeile stehen und im Text der eMail ebenso.
Ich hoffe die laienhafte Beschreibung ist verständlich und hoffe auf den ein oder anderen Tip, würde mich riesig freuen.
Grüße und vorab vielen Dank an alle,
Markus
Anbei noch der Code der soweit auch funktioniert:
Sub InWord()
Set appWord = CreateObject("Word.Application")
Set docTest = appWord.documents.Add("file:///C\xxxx.docx")
Dim SelectedRow As Integer
SelectedRow = ActiveCell.Row
appWord.Visible = True
docTest.Activate
docTest.Bookmarks("Status").Range.Text = Range("K" & SelectedRow)
docTest.Bookmarks("LfdNr").Range.Text = Range("A" & SelectedRow)
docTest.Bookmarks("Text1").Range.Text = Range("B" & SelectedRow)
docTest.Bookmarks("Text2").Range.Text = Range("C" & SelectedRow)
docTest.Bookmarks("Text3").Range.Text = Range("D" & SelectedRow)
docTest.Bookmarks("Text4").Range.Text = Range("E" & SelectedRow)
docTest.Bookmarks("KDA").Range.Text = Range("F" & SelectedRow)
docTest.Bookmarks("Grund").Range.Text = Range("G" & SelectedRow)
docTest.Bookmarks("Datum1").Range.Text = Range("H" & SelectedRow)
docTest.Bookmarks("Name1").Range.Text = Range("I" & SelectedRow)
docTest.Bookmarks("Tel1").Range.Text = Range("J" & SelectedRow)
docTest.Bookmarks("Datum2").Range.Text = Range("L" & SelectedRow)
docTest.Bookmarks("Name2").Range.Text = Range("M" & SelectedRow)
docTest.Bookmarks("Tel2").Range.Text = Range("N" & SelectedRow)
docTest.Bookmarks("Bemerkung").Range.Text = Range("O" & SelectedRow)
Set docTest = appWord.ActiveDocument
Set appWord = appWord.ActiveDocument
End Sub
Kommentieren
Teilen
Auf Facebook teilen
Auf X (Twitter) teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 487934
Url: https://administrator.de/forum/excel-in-word-datei-diese-speichern-und-an-verteiler-senden-vba-487934.html
Ausgedruckt am: 12.05.2025 um 20:05 Uhr
2 Kommentare
Neuester Kommentar
Grüezi wohl.
Ungefähr so
Habe eine schöne Zeit.
Uf Wiederluege.
Ungefähr so
Sub InWord()
Dim SelectedRow As Integer, strPath As String
With CreateObject("Word.Application")
.Visible = True
With .Documents.Add("C:\xxxx.docx")
SelectedRow = Selection.Row
.Bookmarks("Status").Range.Text = Range("K" & SelectedRow)
.Bookmarks("LfdNr").Range.Text = Range("A" & SelectedRow)
.Bookmarks("Text1").Range.Text = Range("B" & SelectedRow)
.Bookmarks("Text2").Range.Text = Range("C" & SelectedRow)
.Bookmarks("Text3").Range.Text = Range("D" & SelectedRow)
.Bookmarks("Text4").Range.Text = Range("E" & SelectedRow)
.Bookmarks("KDA").Range.Text = Range("F" & SelectedRow)
.Bookmarks("Grund").Range.Text = Range("G" & SelectedRow)
.Bookmarks("Datum1").Range.Text = Range("H" & SelectedRow)
.Bookmarks("Name1").Range.Text = Range("I" & SelectedRow)
.Bookmarks("Tel1").Range.Text = Range("J" & SelectedRow)
.Bookmarks("Datum2").Range.Text = Range("L" & SelectedRow)
.Bookmarks("Name2").Range.Text = Range("M" & SelectedRow)
.Bookmarks("Tel2").Range.Text = Range("N" & SelectedRow)
.Bookmarks("Bemerkung").Range.Text = Range("O" & SelectedRow)
strPath = "C:\ordner\" & Range("A" & SelectedRow) & "_" & Format(now,"YYYY_MM_DD_HH_mm") & ".docx"
.SaveAs2 strPath
.Close True
End With
.Quit
End With
With CreateObject("Outlook.Application").CreateItem(0)
.To = "GruppeXYZ@domain.tld"
.Subject = "Laufende Nr.: " & Range("A" & SelectedRow)) & " / Status : " & Range("K" & SelectedRow)
.Body = "Laufende Nr.: " & Range("A" & SelectedRow)) & " / Status : " & Range("K" & SelectedRow)
.Attachments.Add strPath
.Display
'.Send
End With
End SubUf Wiederluege.
Hallo psuser,
vielen Dank für die sehr schnelle Antwort, das war die Lösung.
Ich hab sie noch ein wenig angepasst, jetzt funktionieren alles so wie es soll. (Siehe Code)
Viele Grüße von der anderen Seite vom Bodensee, so nah und doch so fern! (Siehe Foto)
vielen Dank für die sehr schnelle Antwort, das war die Lösung.
Ich hab sie noch ein wenig angepasst, jetzt funktionieren alles so wie es soll. (Siehe Code)
Viele Grüße von der anderen Seite vom Bodensee, so nah und doch so fern! (Siehe Foto)
Sub InWord()
Set appWord = CreateObject("Word.Application")
Set docTest = appWord.documents.Add("file:///C:\Users\49176\OneDrive\Desktop\Motorsperrung\Backup_Exceltabelle\Sperrformular.docx")
Dim SelectedRow As Integer
SelectedRow = ActiveCell.Row
appWord.Visible = True
docTest.Activate
docTest.Bookmarks("Status").Range.Text = Range("K" & SelectedRow)
docTest.Bookmarks("LfdNr").Range.Text = Range("A" & SelectedRow)
docTest.Bookmarks("Text1").Range.Text = Range("B" & SelectedRow)
docTest.Bookmarks("Text2").Range.Text = Range("C" & SelectedRow)
docTest.Bookmarks("Text3").Range.Text = Range("D" & SelectedRow)
docTest.Bookmarks("Text4").Range.Text = Range("E" & SelectedRow)
docTest.Bookmarks("KDA").Range.Text = Range("F" & SelectedRow)
docTest.Bookmarks("Grund").Range.Text = Range("G" & SelectedRow)
docTest.Bookmarks("Datum1").Range.Text = Range("H" & SelectedRow)
docTest.Bookmarks("Name1").Range.Text = Range("I" & SelectedRow)
docTest.Bookmarks("Tel1").Range.Text = Range("J" & SelectedRow)
docTest.Bookmarks("Datum2").Range.Text = Range("L" & SelectedRow)
docTest.Bookmarks("Name2").Range.Text = Range("M" & SelectedRow)
docTest.Bookmarks("Tel2").Range.Text = Range("N" & SelectedRow)
docTest.Bookmarks("Bemerkung").Range.Text = Range("O" & SelectedRow)
strPath = "C:\Users\Test\" & Range("A" & SelectedRow).Text & Format(Now, "_YYYYMMDD_hh.mm") & ".docx"
appWord.ActiveDocument.SaveAs strPath
appWord.ActiveDocument.Close True
With CreateObject("Outlook.Application").CreateItem(0)
.To = "0815@test.de"
.Subject = "Information zu Motorsperrung-Nr.: " & Range("A" & SelectedRow) & " / Motor-Nr." & Range("E" & SelectedRow) & " / " & "Der " & Range("K" & SelectedRow)
.Body = "Sehr geehrte Damen und Herren," & vbCrLf & vbCrLf & "Information zu Motorsperrung-Nr.: " & Range("A" & SelectedRow) & " / Motor-Nr." & Range("E" & SelectedRow) & vbCrLf & vbCrLf & "Der " & Range("K" & SelectedRow) & vbCrLf & vbCrLf & "Für Änderungen im Email-Verteiler bitte Email an xy@test.com oder an xz@test.com" & vbCrLf & vbCrLf
.Attachments.Add strPath
.Display
'.Send
End With
End Sub
