mrnice78
Aug 23, 2019
view3895
view2
0
Goto Top

Excel in Word-Datei, diese speichern und an Verteiler senden VBA

GermansolvedQuestionMicrosoft OfficeMicrosoft
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:

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
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 487934

Url: https://administrator.de/contentid/487934

Printed on: April 26, 2024 at 03:04 o'clock

2 Comments
Latest comment
Goto Top
Mitglied: 140913
Solution 140913 Aug 23, 2019 updated at 13:06:06 (UTC)
Goto Top
Grüezi wohl.

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 Sub
Habe eine schöne Zeit.

Uf Wiederluege.
Member: MrNice78
MrNice78 Aug 23, 2019 at 13:34:04 (UTC)
Goto Top
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)

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

dji_0017
GermansolvedQuestionMicrosoft OfficeMicrosoft
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 Comments