Short explanation: There are 3.Letter Templates and i want them to print per Button. But the main problem here is, that the Code is Printing the Template for every Person in the Worksheet also if the Person already had a Letter. It should look something like this.
-If the selected letter in "G3" is 1. Letter then send them only to People where the Cell Range in "Z" is Empty
-If the selected letter in "G3" is 2. Letter then send them only to People where the Cell in Range "Z" is 1.Letter
-If the selected letter in "G3" is 3. Letter then send them only to People where the Cell in Range "Z" is 2.Letter
What do i need to write right here?
Thank you for your answer in Advance!
https://i.stack.imgur.com/1NRbv.png
Option Explicit
Sub CreateWordDocuments()
Dim CustRow, CustCol, LastRow, TemplRow, DaysSince, FrDays, ToDays As Long
Dim DocLoc, TagName, TagValue, TemplName, FileName As String
Dim CurDt, LastAppDt As Date
Dim OutApp, OutMail As Object
Dim WordContent As Word.Range
Dim WordDoc As Word.Document
Dim WordApp As Word.Application
With Tabelle1
If IsEmpty(Range("G3").Value) = True Then
MsgBox "Bitte w?hlen sie eine Vorlage aus"
.Range("G3").Select
Exit Sub
End If
TemplRow = .Range("B3").Value
TemplName = .Range("G3").Value
FrDays = .Range("L3").Value
ToDays = .Range("N3").Value
DocLoc = Tabelle2.Range("F" & TemplRow).Value
On Error Resume Next
Set WordApp = GetObject("Word.Application")
If Err.Number <> 0 Then
Err.Clear
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
End If
***LastRow = .Range("E9999").End(xlUp).Row
For CustRow = 8 To LastRow
DaysSince = .Range("P" & CustRow).Value
If TemplName <> .Range("Z" & CustRow).Value And DaysSince >= FrDays And DaysSince <= ToDays Then
Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False)
For CustCol = 5 To 26
TagName = .Cells(7, CustCol).Value
TagValue = .Cells(CustRow, CustCol).Value
With WordDoc.Content.Find
.Text = TagName
.Replacement.Text = TagValue
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With***
Next CustCol
If .Range("I3").Value = "PDF" Then
FileName = "Filename" & "" & .Range("H" & CustRow).Value & " " & .Range("G" & CustRow).Value & " " & .Range("G3").Value & ".pdf"
WordDoc.ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
WordDoc.Close False
Else:
FileName = ThisWorkbook.Path & "" & .Range("H" & CustRow).Value & "_" & .Range("G" & CustRow).Value & ".docx"
WordDoc.SaveAs FileName
End If
.Range("Z" & CustRow).Value = TemplName
.Range("AA" & CustRow).Value = Now
If .Range("P3").Value = "Email" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Tabelle1.Range("K" & CustRow).Value
.Subject = "Hallo, " & Tabelle1.Range("F" & CustRow).Value & "Test Test Test"
.Body = "Hallo, " & Tabelle1.Range("F" & CustRow).Value & "Test Test Test Test"
.Attachments.Add FileName
.Display
End With
Else:
WordDoc.PrintOut
WordDoc.Close
End If
Kill False '(FileName)
End If
Next CustRow
WordApp.Quit
End With
End Sub
question from:
https://stackoverflow.com/questions/65903613/how-to-make-a-loop-in-an-if-statement 与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…