![]() |
|
#1
|
|||
|
|||
|
I haved a pricing worksheet that our workgroup uses. It opens a Word Document from and Excel Worksheet and merges info from Excel to Word. It worked fine while everyone was using Office 2007. The users that have Office 2010 installed on their computers are getting a Run Time Error 4248 when they attempt to create the Word document from the Word Template. Here is a piece of the VBA code in the Excel worksheet. Code:
Dim wrdApp As Word.Application
Set wrdApp = CreateObject("Word.Application")
Application.ScreenUpdating = False
With wrdApp
.Documents.Add Template:="G:\ABP\ArchSpec\A-Operations\Group Templates\Quote Templates\MWLinearQuote.dotx"
|
|
#2
|
||||
|
||||
|
That error usually occurs when you try to do something with a document that hasn't opened. In this case, that could be because Word can't find the referenced template. Can the affected users access the template by inserting the path as coded into Windows Explorer?
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#3
|
|||
|
|||
|
They can, but then it doesn't populate correctly.
|
|
#4
|
||||
|
||||
|
Granted, but that wasn't the point of the question, which was to establish that Word 2010 correctly creates a document from the template.
That being established, which code line, if any, is highlighted when you get the 4248 error?
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#5
|
|||
|
|||
|
Thanks, Paul. I've highlighted the line where the error occurs. It only occurs sometimes though, so it seems to be some kind of timing thing.
Code:
Sub OCLayin_CreateQuote()
'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 myFileName As String
myProject = ActiveWorkbook.Sheets("Project Setup").Range("B4")
myCompanyInfoL1 = ActiveWorkbook.Sheets("Project Setup").Range("B8")
myCompanyInfoL2 = ActiveWorkbook.Sheets("Project Setup").Range("B6") & " - " & ActiveWorkbook.Sheets("Project Setup").Range("B7")
myCompanyInfoL3 = ActiveWorkbook.Sheets("Project Setup").Range("B5")
myQuoteNumber = ActiveWorkbook.Sheets("Project Setup").Range("E4")
mycustomer = ActiveWorkbook.Sheets("Project Setup").Range("B6")
mydate = ActiveWorkbook.Sheets("Project Setup").Range("E5")
myuser = ActiveWorkbook.Sheets("Project Setup").Range("E7")
myDate1 = ActiveWorkbook.Sheets("Project Setup").Range("A45")
Dim wrdApp As Word.Application
Set wrdApp = CreateObject("Word.Application")
Application.ScreenUpdating = False
With wrdApp
.Documents.Add Template:="G:\ABP\ArchSpec\A-Operations\Group Templates\Quote Templates\OpenCellQuote.dotx"
If .ActiveDocument.Bookmarks.Exists("Project") Then
.ActiveDocument.Bookmarks("Project").Range.Text = myProject
End If
If .ActiveDocument.Bookmarks.Exists("ToL1") Then
.ActiveDocument.Bookmarks("ToL1").Range.Text = myCompanyInfoL1
End If
If .ActiveDocument.Bookmarks.Exists("ToL2") Then
.ActiveDocument.Bookmarks("ToL2").Range.Text = myCompanyInfoL2
End If
If .ActiveDocument.Bookmarks.Exists("ToL3") Then
.ActiveDocument.Bookmarks("ToL3").Range.Text = myCompanyInfoL3
End If
If .ActiveDocument.Bookmarks.Exists("Date") Then
.ActiveDocument.Bookmarks("Date").Range.Text = mydate
End If
If .ActiveDocument.Bookmarks.Exists("User") Then
.ActiveDocument.Bookmarks("User").Range.Text = myuser
End If
If .ActiveDocument.Bookmarks.Exists("QuoteNo") Then
.ActiveDocument.Bookmarks("QuoteNo").Range.Text = myQuoteNumber
End If
If .ActiveDocument.Bookmarks.Exists("Esc") Then
.ActiveDocument.Bookmarks("Esc").Range.Text = myDate1
End If
If .ActiveDocument.Bookmarks.Exists("Table") Then
ThisWorkbook.Sheets("Quote OC Lay-in").Range("A11:H40").Copy
.Selection.GoTo What:=wdGoToBookmark, Name:="Table"
.Selection.Paste
End If
myFileName = myProject & " " & myQuoteNumber & "_" & mycustomer & " " & "Quote" & " "
With .Dialogs(wdDialogFileSummaryInfo)
.Title = myFileName
.Execute
End With
.Visible = True
.ActiveDocument.SaveAs ("G:\ABP\ArchSpec\Project Files\Quotes\2014\Premium\MW Open Cell\" & myFileName & Format(Date, "mm-dd-yy") & ".docx")
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Last edited by macropod; 02-16-2014 at 03:01 PM. Reason: Added code tags & formatting |
|
#6
|
||||
|
||||
|
Hi CIF,
There's no apparent highlighting in the code you posted. PS: When posting code, please use the code tags (which I've now added to your post, plus re-formatting because all of it had been lost). They're on the 'Go Advanced' tab.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#7
|
|||
|
|||
|
Thank you so much for your patience, Paul. This is my first time posting on a forum like this and I read the instructions, but I obviously did not understand them very well. The run time error occurs on this line:
If .ActiveDocument.Bookmarks.Exists("Project") Then |
|
#8
|
||||
|
||||
|
Try:
Code:
Sub OCLayin_CreateQuote()
'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 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("E4").Text
mycustomer = .Range("B6").Text
mydate = .Range("E5").Text
myuser = .Range("E7").Text
myDate1 = .Range("A45").Text
End With
Set wrdDoc = wrdApp.Documents.Add(Template:= _
"G:\ABP\ArchSpec\A-Operations\Group Templates\Quote Templates\OpenCellQuote.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("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("Table") Then
ThisWorkbook.Sheets("Quote OC Lay-in").Range("A11:H40").Copy
.Bookmarks("Table").Range.Paste
End If
myFileName = myProject & " " & myQuoteNumber & "_" & mycustomer & " " & "Quote" & " "
With wrdApp.Dialogs(wdDialogFileSummaryInfo)
.Title = myFileName
.Execute
End With
.SaveAs2 "G:\ABP\ArchSpec\Project Files\Quotes\2014\Premium\MW Open Cell\" _
& myFileName & Format(Date, "mm-dd-yy") & ".docx", _
FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
End With
wrdApp.Visible = True
Set wrdDoc = Nothing: Set wrdApp = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#9
|
|||
|
|||
|
Thank you, Paul! I really think this is the answer. I'll try it tomorrow morning and will let you know how it went.
|
|
#10
|
|||
|
|||
|
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
|
|
#11
|
||||
|
||||
|
There's no message with the code you've posted!
At a guess, I'd say you're wanting help with this line: With .Dialogs(wdDialogFileSummaryInfo) Change that to: With wrdApp.Dialogs(wdDialogFileSummaryInfo)
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#12
|
|||
|
|||
|
Thank you for all of your help! I did rewrite the code in one of my workbooks, according to our suggestion and it did not help. Now instead of getting an error message, user's computer just sits there while it is looping through the code. When I opened his worksheet, I could not create a Word document with the macro either. It has something to do with his Reference being Microsoft Word 14.0 Object Library instead of the 12.0 Object Library I have. I'll keep trying!
|
|
#13
|
||||
|
||||
|
I doubt the Word 12 & 14 references have anything to do with it. Code compiled with references to a given Word version compile with later versions also, though the reverse doesn't work.
Since nothing's happening, that suggests that user is unable to create the Word document. That, in turn, suggests a problem with either their user profile (e.g. permissions) or network connection.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
Run-time Error 5174: Open Word Documents from Excel
|
tinfanide | Excel Programming | 3 | 10-01-2013 07:35 AM |
Open Word w Excel & fill Word textboxes w info from Excel fields runtime error 4248
|
Joe Patrick | Word VBA | 2 | 01-30-2012 07:23 AM |
| Word Visual Basic error - run time error 504 | crazymorton | Word | 11 | 01-13-2012 04:32 AM |
MS Word - There was an error opening the file
|
cookiegal | Word | 7 | 04-04-2011 12:37 AM |
| Error opening word from a doc. | Davem501 | Word | 0 | 12-01-2009 02:10 AM |