floggingmolly
Board Regular
- Joined
- Sep 14, 2019
- Messages
- 167
- Office Version
- 365
- Platform
- Windows
I have a VBA code that fills in a word template from data in an excel sheet. The macro runs fine on 2 computers, but on the third computer it gives an error on the line .Wrap = wdFindContinue. The error says Compile error: Can't find project or library. The reference to Word is checked. Trying to troubleshoot and find a solution but not having any luck. If anyone cares to takes a look at the code and make any suggestions it would be appreciated.
Code:
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 WordDoc, WordApp, OutApp, OutMail As Object
Dim WordContent As Word.Range
With Sheet1
If .Range("B3").Value = Empty Then
MsgBox "Please select a correct template from the drop down list"
.Range("D3").Select
Exit Sub
End If
TemplRow = .Range("B3").Value 'Set Template Row
TemplName = .Range("D3").Value 'Set Template Name
FrDays = .Range("K3").Value 'Set From Days
ToDays = .Range("M3").Value 'Set To Days
DocLoc = Sheet2.Range("F" & TemplRow).Value 'Word Document Filename
'Open Word Template
On Error Resume Next 'If Word is already running
Set WordApp = GetObject("Word.Application")
If Err.Number <> 0 Then
'Launch a new instance of Word
Err.Clear
'On Error GoTo Error_Handler
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True 'Make the application visible to the user
End If
lastRow = .Range("E500").End(xlUp).Row 'Determine Last Row in Table
For CustRow = 8 To lastRow
DaysSince = .Range("S" & CustRow).Value
If TemplName <> .Range("S" & CustRow).Value And DaysSince >= FrDays And DaysSince <= ToDays Then
Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False) 'Open Template
For CustCol = 1 To 19 'Move Through 9 Columns
TagName = .Cells(7, CustCol).Value 'Tag Name
TagValue = .Cells(CustRow, CustCol).Value 'Tag Value
With WordDoc.Content.Find
.Text = TagName
.Replacement.Text = TagValue
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll 'Find & Replace all instances
End With
Next CustCol
If .Range("F3").Value = "PDF" Then
FileName = ThisWorkbook.Path & "\EXTENSION LETTERS\" & "\" & .Range("D" & CustRow).Value & " - " & .Range("I" & CustRow).Value & " - " & .Range("Y1").Value & " - " & .Range("X1").Value & ".pdf" 'Create full filename & Path with current workbook location, Last Name & First Name
WordDoc.ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
FileName = ThisWorkbook.Path & "\EXTENSION LETTERS\" & "\" & .Range("D" & CustRow).Value & " - " & .Range("I" & CustRow).Value & " - " & .Range("Y1").Value & " - " & .Range("X1").Value & ".docx"
WordDoc.SaveAs FileName
Application.Wait (Now + TimeValue("0:00:05"))
WordDoc.Close False
Else: 'If Word
FileName = ThisWorkbook.Path & "\Word Files\" & "\" & .Range("D" & CustRow).Value & " - " & .Range("E" & CustRow).Value & ".docx"
WordDoc.SaveAs FileName
Application.Wait (Now + TimeValue("0:00:05"))
End If
.Range("T" & CustRow).Value = TemplName 'Template Name
.Range("U" & CustRow).Value = Now
If .Range("H3").Value = "Email" Then
Set OutApp = CreateObject("Outlook.Application") 'Create Outlook Application
Set OutMail = OutApp.CreateItem(0) 'Create Email
With OutMail
.SentOnBehalfOfName = "BDSNoReply@fedex.com"
.To = Sheet1.Range("R" & CustRow).Value
.Subject = "GOLD status recognition for " & Sheet1.Range("F" & CustRow).Value
.Body = "Upon reviewing the most recent Fiscal Quarter of Service Provider results in MEDALS, " & Sheet1.Range("C" & CustRow).Value & vbCrLf & _
"has been identified as having attained Gold status for each month of the Quarter. This is a noteworthy" _
& vbCrLf & "achievement and we ask that you recognize this business in a public forum. Attached you will find" _
& vbCrLf & "a letter from Paul Melander, Senior Vice President of Safety & Transportation, congratulating " _
& vbCrLf & "and thanking " & Sheet1.Range("C" & CustRow).Value & "for this achievement. Please use the following guidelines:" _
& vbCrLf & vbCrLf & " " & Chr(149) & "The business should be recognized in a meeting with their peers" _
& vbCrLf & " " & Chr(149) & "The attached letter should be printed on high quality paper and presented to the Authorized Officer in this meeting" _
& vbCrLf & " " & Chr(149) & "They should be thanked for their dedication to safety and service" _
& vbCrLf & vbCrLf & "We appreciate your efforts in this task. For further questions feel free to reach out to your local Business Development Solutions resources." _
& vbCrLf & vbCrLf & "Thank you," _
& vbCrLf & "Business Development Solutions - Agreement Management"
.Attachments.Add FileName
.Display 'To send without Displaying change .Display to .Send
Application.Wait (Now + TimeValue("0:00:3"))
End With
Else:
WordDoc.Close False
End If
End If '3 condition met
Next CustRow
WordApp.Quit
End With
End Sub
