Hi guys,
I was hoping you could help me with something quickly. I have the following script:
Code:
Sub rejection()
' word document object creation
Dim WordApp As Object
Dim i As Integer, j As Integer, numRows As Integer
' show the actions that the macro is performing for now
Application.ScreenUpdating = False
' the submissions worksheet must be selected
Set Data = ActiveSheet.Range("A1")
numRows = ActiveSheet.UsedRange.Rows.Count
For i = 1 To numRows
' pull column for each row into dynamic strings
rejectType = Data.Offset(i - 1, 4).Value
authorString = Data.Offset(i - 1, 1).Value
insightsString = Data.Offset(i - 1, 6).Value
alternateJournalString = Data.Offset(i - 1, 5).Value
' if no value for field
If rejectType <> "quality" And rejectType <> "Subject" Then
GoTo Nextif
End If
If rejectType = "quality" And qualityRejectionTemplateFile = "" Then
MsgBox ("Please locate Quality-based rejection letter template file")
qualityRejectionTemplateFile = Application.GetOpenFilename
ElseIf rejectType = "Subject" And subjectRejectionTemplateFile = "" Then
MsgBox ("Please locate Subject-based rejection letter template file")
subjectRejectionTemplateFile = Application.GetOpenFilename
End If
' create rejection letter
Set WordApp = CreateObject("Word.Application")
With WordApp
Application.StatusBar = "Creating " & rejectType & "rejection letter from template"
.Visible = True
' should be .dot, a template file
' should be placed in the same directory as the excel file that this is being called from
If rejectType = "quality" Then
.Documents.Open qualityRejectionTemplateFile
ElseIf rejectType = "Subject" Then
.Documents.Open subjectRejectionTemplateFile
End If
' clear out find and replace fields
.Selection.Find.ClearFormatting
.Selection.Find.Replacement.ClearFormatting
' find and replace the name in the document
With .Selection.Find
.Text = "<Name>"
.Replacement.Text = authorString
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
' clear out find and replace fields
.Selection.Find.ClearFormatting
.Selection.Find.Replacement.ClearFormatting
' find and replace the Insights in the document
With .Selection.Find
.Text = "<insights>"
.Replacement.Text = insightsString
.Wrap = wdFindStop
End With
.Selection.Find.Execute Replace:=wdReplaceAll
' clear out find and replace fields
.Selection.Find.ClearFormatting
.Selection.Find.Replacement.ClearFormatting
' find and replace the Alternate Journal name in the document
With .Selection.Find
.Text = "<Alternate Journal>"
.Replacement.Text = alternateJournalString
End With
.Selection.Find.Execute Replace:=wdReplaceAll
' save document with appropriate name and close
.ActiveDocument.SaveAs Filename:=authorString & "_reject_" & rejectType & ".doc"
.ActiveWindow.Close
' Kill the object
.Quit
End With
Nextif:
Next i
End Sub
For the life of me, I cannot figure out why the Replacement.Text function doesn't work. When the macro is running, you can see it select <Name>, but it doesn't make any changes before it closes it and opens a new instance (It doesn't move on to <insights> or <alternate journal>)
Anyone have any ideas??
Thank you so much. I've learned a lot from these boards.