#1
|
|||
|
|||
Run Time Error 4248 when opening Word Doc from Excel
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
|
|||
|
|||
Applied code to one of my worksheets and now getting error message at red-type line.
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] |
Thread Tools | |
Display Modes | |
|
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 |