Code:
Sub Soundsoak_CreateQuote1()
'Collect the Needed Information
Dim myProject, myCompanyInfoL1, myCompanyInfoL2, myCompanyInfoL3, myQuoteNumber As String
Dim mycustomer, mydate As String, myuser As String, myDate1 As String, myDate2 As String, myDate3 As String
Dim myquote1, myquote2, myquote3, myquote4, myquote5, myquote6, myquote7, myquote8 As String
Dim myFileName As String
Dim wrdApp As Word.Application, wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
Application.ScreenUpdating = False
With ActiveWorkbook.Sheets("Project Setup")
myProject = .Range("B4").Text
myCompanyInfoL1 = .Range("B8").Text
myCompanyInfoL2 = .Range("B6").Text & " - " & .Range("B7").Text
myCompanyInfoL3 = .Range("B5").Text
myQuoteNumber = .Range("E5").Text
mycustomer = .Range("B6").Text
mydate = .Range("E6").Text
myuser = .Range("E8").Text
myDate1 = .Range("A29").Text
myDate2 = .Range("A30").Text
myDate3 = .Range("A31").Text
End With
With ActiveWorkbook.Sheets("Quote Opt 1")
myquote1 = .Range("F4").Text
myquote2 = .Range("F5").Text
myquote3 = .Range("F6").Text
myquote4 = .Range("F8").Text
myquote5 = .Range("F9").Text
myquote6 = .Range("F10").Text
myquote7 = .Range("F11").Text
myquote8 = .Range("F12").Text
End With
Set wrdDoc = wrdApp.Documents.Add(Template:="G:\ABP\ArchSpec\A-Operations\Group Templates\Quote Templates\SoundsoakQuote1.dotx")
Do While wrdDoc Is Nothing: Loop
With wrdDoc
If .Bookmarks.Exists("Project") Then .Bookmarks("Project").Range.Text = myProject
If .Bookmarks.Exists("ToL1") Then .Bookmarks("ToL1").Range.Text = myCompanyInfoL1
If .Bookmarks.Exists("ToL2") Then .Bookmarks("ToL2").Range.Text = myCompanyInfoL2
If .Bookmarks.Exists("ToL3") Then .Bookmarks("ToL3").Range.Text = myCompanyInfoL3
If .Bookmarks.Exists("Header1") Then .Bookmarks("Header1").Range.Text = myCompanyInfoL2
If .Bookmarks.Exists("Date") Then .Bookmarks("Date").Range.Text = mydate
If .Bookmarks.Exists("User") Then .Bookmarks("User").Range.Text = myuser
If .Bookmarks.Exists("QuoteNo") Then .Bookmarks("QuoteNo").Range.Text = myQuoteNumber
If .Bookmarks.Exists("Esc") Then .Bookmarks("Esc").Range.Text = myDate1
If .Bookmarks.Exists("Esc1") Then .Bookmarks("Esc1").Range.Text = myDate1
If .Bookmarks.Exists("Esc2") Then .Bookmarks("Esc2").Range.Text = myDate2
If .Bookmarks.Exists("Esc3") Then .Bookmarks("Esc3").Range.Text = myDate3
If .Bookmarks.Exists("Project1") Then .Bookmarks("Project1").Range.Text = myProject
If .Bookmarks.Exists("QuoteNo1") Then .Bookmarks("QuoteNo1").Range.Text = myQuoteNumber
If .Bookmarks.Exists("Q1") Then .Bookmarks("Q1").Range.Text = myquote1
If .Bookmarks.Exists("Q2") Then .Bookmarks("Q2").Range.Text = myquote2
If .Bookmarks.Exists("Q3") Then .Bookmarks("Q3").Range.Text = myquote3
If .Bookmarks.Exists("Q4") Then .Bookmarks("Q4").Range.Text = myquote4
If .Bookmarks.Exists("Q5") Then .Bookmarks("Q5").Range.Text = myquote5
If .Bookmarks.Exists("Q6") Then .Bookmarks("Q6").Range.Text = myquote6
If .Bookmarks.Exists("Q7") Then .Bookmarks("Q7").Range.Text = myquote7
If .Bookmarks.Exists("Q8") Then .Bookmarks("Q8").Range.Text = myquote8
If .Bookmarks.Exists("Table") Then
ThisWorkbook.Sheets("Quote Opt 1").Range("Table1", LastNonBlankCell(Sheets("Quote Opt 1"))).Copy
.Bookmarks("Table").Range.Paste
End If
myFileName = myProject & " " & myQuoteNumber & "_" & mycustomer & " " & "Quote" & " "
With .Dialogs(wdDialogFileSummaryInfo)
.Title = myFileName
.Execute
End With
.SaveAs ("G:\ABP\ArchSpec\Project Files\Quotes\2014\Soundsoak\" & myFileName & Format(Date, "mm-dd-yy") & ".docx")
End With
wrdApp.Visible = True
Set wrdDoc = Nothing: Set wrdApp = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub