I haven't found anything that can help me.
I'm trying to open a certain word file, have some data written in it and saved under a different name. This is what I have so far:
Dim appWD As Word.Application
Set appWD = CreateObject("Word.Application.8")
Set appWD = New Word.Application
Dim docWD As Word.Document
Set docWD = appWD.Documents.Open("C:\Documents and Settings\Excel macro\Standaard.docx")
appWD.Visible = True
'
' Data is selected and copied into "Design"
'
Copy all data from Design
Sheets("Design").Select
Range("A1:G50").Copy
' Tell Word to create a new document
appWD.Documents.Add
' Tell Word to paste the contents of the clipboard into the new document
appWD.Selection.Paste
' Save the new document with a sequential file name
Sheets("Sheet1").Select
appWD.ActiveDocument.SaveAs Filename:=ThisWorkbook.Path & "/" & "TEST" & Range("C8").Text
' Close this new word document
appWD.ActiveDocument.Close
' Close the Word application
appWD.Quit
At the moment all it does is; open the Standaard.docx file, open a new file and paste everything in the new file and saves. It should open the Standaard.docx file, paste it in there and save under a new name.
Many thanks!
The reason that it opens a new document is because you have the line:
appWD.Documents.Add
in your code before the line:
appWD.Selection.Paste
if you remove the appWD.Documents.Add Word will paste into your active document (i.e. "Standaard.docx").
Just one other point, you do not need the line:
Set appWD = CreateObject("Word.Application.8")
as you immediately initialise a new Word application in the line below it with:
Set appWD = New Word.Application
This macro opens a file then saves it as a new file name in a different folder based on info updated in the sheet1 of the Excel file
Sub OpenDocFileNewName()
'
' OpenDocFileNewName Macro
'
'
Set WordApp = CreateObject("Word.Application.8")
Set WordDoc = WordApp.Documents.Open("C:\Users\mmezzolesta\Documents\_TestDataMerge\STANDARD.docx")
WordApp.Visible = True
'
'
'Save as new file name
Sheets("Sheet1").Select
WordApp.ActiveDocument.SaveAs Filename:=("C:\Users\mmezzolesta\Documents\_TestMailMergeAuto") & "/" & Range("A2") & "Standard-Grounding-" & Range("e2").Text
WordApp.ActiveDocument.Close
WordApp.Quit
'
'
End Sub
Related
I'm trying to open a Word Document and copy the whole table inside it and then paste it into another already-open document after a specific heading/bookmark (that I have bookmarked in the document). Then finally prompt the user to save the document with the newly pasted table.
Examples seen online are Excel-to-Word or Word-to-Excel; I need Word-to-Word.
I'm able to pull up the first document (I think it successfully copies it, too--I haven't tested it), but when it activates the second document, it stops and gives an error that it doesn't have an object assigned.
The debugger highlights Set WrdRng = Active.Bookmarks("AppendixA").Range.
Sub TEST()
'
' Declare Table Document Var as Object
Dim tb As Object
Dim bk As Bookmark
Dim WrdRng As Range
'
'
'Set up Word Application
Set tb = CreateObject("Word.Application")
tb.Visible = True
'Opens Pre-Saved Document & activates it to use
tb.Documents.Open "C:\ Desktop\Table.dotm"
tb.Activate
Selection.WholeStory
'ActiveDocument.Tables(1).Select
Selection.Font.Name = "Calibri"
Selection.Copy
'Activate Rolling Trend Report Document and Paste
Windows("TEST - Compatibility Mode").Activate
' where the error occurs and the debugger highlights
Set WrdRng = Active.Bookmarks("AppendixA").Range
'Paste to Bookmark
With WrdRng
Selection.InsertAfter
End With
'Save Completed Report to Desktop
ChangeFileOpenDirectory "C: \Desktop\"
ActiveDocument.SaveAs2 FileName:="TEST.docm", _
FileFormat:=wdFormatXMLDocumentMacroEnabled
'
'
'
End Sub
Your code is failing because Set WrdRng = Active.Bookmarks("AppendixA").Range should be Set WrdRng = ActiveDocument.Bookmarks("AppendixA").Range
However, your code is badly written, will also fail in other places and will create an extra instance of Word.
The code below is to run from Word
Sub TEST()
'store a pointer to the document you wnat to insert table into
'assumed to be currently active document
Dim targetDoc As Document
Set targetDoc = ActiveDocument
'Open Pre-Saved Document
Dim tblDoc As Document
Set tblDoc = Documents.Open("C:\ Desktop\Table.dotm")
Dim source As Range
Set source = tblDoc.Content
'exclude the paragraph that comes after the table
source.MoveEnd Unit:=wdCharacter, Count:=-1
source.Font.Name = "Calibri"
Dim appxA As Range
Set appxA = targetDoc.Bookmarks("AppendixA").Range
appxA.Collapse wdCollapseEnd
'transfer the text and close the source document
appxA.FormattedText = source.FormattedText
tblDoc.Close wdDoNotSaveChanges
'it is necessary to pass the full file path to the SaveAs command
ActiveDocument.SaveAs2 FileName:="C: \Desktop\TEST.docm", _
FileFormat:=wdFormatXMLDocumentMacroEnabled
End Sub
I am looking for a Macro to export the contents of every table in a Word document(s) and move this content to Excel. Along with pulling the contents of the tables however, I would like the titles of each of these tables to be exported as well. The Word document(s) are formatted in a table of contents style, with the "titles" of the tables being the headers of each section of the table of contents. Some of the sections in the table of contents have no table within the section, in which case, I would like the macro to move on from that section if there is no table within it. I am trying to have this Macro work for multiple Word documents in a single folder. The great news is that I already have a Macro currently working that does everything I asked above EXCEPT for pull the title of each table section. Below is the Macro I am currently using. Any help is greatly appreciated!!
Sub import_word_table_to_excel()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim fldpath
Dim fld, fil As Object
Dim appWord As Word.Application
Dim docWord As Word.Document
Dim tableWord As Word.Table
Dim sdoc As String
' use to choose the folder having word documents
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choose Folder"
Application.FileDialog(msoFileDialogFolderPicker).Show
fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.getfolder(fldpath)
Set appWord = New Word.Application
appWord.Visible = True
For Each fil In fld.Files
' browse word documents in a folder
If UCase(Right(fil.Path, 4)) = UCase(".doc") Or UCase(Right(fil.Path, 5)) = UCase(".docx") Then
Set docWord = appWord.Documents.Open(fil.Path)
For Each tableWord In docWord.Tables
' copy word tables
tableWord.Range.Copy
' paste it on sheet 1 of excel file
Sheets(1).Paste Destination:=Sheets(1).Range("A65356").End(xlUp).Offset(1, 0)
Next
docWord.Close
End If
Next fil
appWord.Quit
Sheets(1).Select
Set tableWord = Nothing
Set docWord = Nothing
Set appWord = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I'm using Excel 2010 with an embedded Word Document. The Word document is basically a communication template with some formatting (bold / underline / hyperlinks).
Process: User opens Excel Document, provides inputs to Excel, and completes template. There is no interaction between the inputs in Excel and the contents of the template.
I'm trying to build out this process such that once they edit the embedded Word Document the user hits a button. The VBA code would then take the contents of the embedded Word document and paste (formatting and all) it as the body of the email. The file would attach itself to that email, and off it would go for approval.
I've been able to locate code to get me part of the way there, and to give props where props are due, I located the code here (see below for the code)
But this doesn't retain the Word Document's Formatting. Any recommendations? Maybe if I could extract the Word contents as HTML that would work. But not sure how to do that. All help appreciated.
Sub Test()
Dim Oo As OLEObject
Dim wDoc As Object 'Word.Document
'Search for the embedded Word document
For Each Oo In Sheet8.OLEObjects
If InStr(1, Oo.progID, "Word.Document", vbTextCompare) > 0 Then
'Open the embedded document
Oo.Verb xlVerbPrimary
'Get the document inside
Set wDoc = Oo.Object
'Copy the contents to cell A1
wDoc.Content.Copy
With Sheet8.Range("M1")
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
'Select any cell to close the document
Sheet8.Range("M1").Select
'Done
Exit For
End If
Next
Set wDoc = Nothing
End Sub
After reviewing comintern's code, I was getting an error I couldn't solve for. I went back to the boards and located some additional code. Merging the two seems to have fixed it.
Sub HTMLExport()
Dim objOnSheet As oleObject
Dim strFileName As String
Dim sh As Shape
Dim objWord As Object ''Word.Document
Dim objOLE As oleObject
Sheet8.Activate
Set sh = ActiveSheet.Shapes("RA_Template")
sh.OLEFormat.Activate
Set objOLE = sh.OLEFormat.Object
Set objWord = objOLE.Object
ActiveSheet.Range("M1").Activate
''Easy enough
strFileName = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\temp.html"
objWord.SaveAs2 Filename:=strFileName, FileFormat:=10 '10=wdFormatFilteredHTML
'Copy the file contents into cell M1...
Dim handle As Integer
handle = FreeFile
Open strFileName For Input As handle
Sheet8.Range("M1").Value = Input$(LOF(handle), handle)
Close handle
'Delete the Temp File (strFileName)
Kill strFileName
'Select any cell to close the document
Sheet8.Range("M1").Select
End Sub`
If getting it into HTML will work (Word makes pretty ugly HTML...), you can just save it to a temp file and then pick it back up:
Sub HTMLExport()
Dim Oo As OLEObject
'Search for the embedded Word document
For Each Oo In Sheet8.OLEObjects
If InStr(1, Oo.progID, "Word.Document", vbTextCompare) > 0 Then
Dim temp As String
'GetSpecialFolder(2) gives the user's temp folder.
temp = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\temp.html"
'10 = wdFormatFilteredHTML
Oo.Object.SaveAs2 temp, 10
'Copy the file contents into cell M1...
Dim handle As Integer
handle = FreeFile
Open temp For Input As handle
Sheet8.Range("M1").Value = Input$(LOF(handle), handle)
Close handle
'...and delete the temp file.
Kill temp
'Select any cell to close the document
Sheet8.Range("M1").Select
'Done
Exit For
End If
Next
End Sub
Note that if you're using this method, you can't open the embedded Word document after you get the OLEObject or Word won't allow you to save it.
I created a word template with placeholders such as <> that I am then able to replace automatically with my excel macro. When I tried this process again, the word document now opens saying it is a read only document. How am I supposed to save my Word Template so it can be edited? Also, when I open the word template through my excel macro, how does it know to save it as a new word document, and not save it as an updated template?
Here is my code:
Sub ReplaceText()
Dim wApp As Word.Application
Dim wDoc As Word.Document
Set wApp = CreateObject("Word.Application")
wApp.Visible = True
Set wDoc = wApp.Documents.Open("file name here")
With wDoc
.Application.Selection.Find.Text = "<<name>>"
.Application.Selection.Find.Execute
.Application.Selection = Range("A5")
.Application.Selection.EndOf
.Application.Selection.Find.Text = "<<dob>>"
.Application.Selection.Find.Execute
.Application.Selection = Range("A6")
.SaveAs2 Filename:=("file name goes here"), _
FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False
End With
End Sub
While #wahwahwah's approach works, it is still opening the template as a document for editing, then saving it in another format, while suppressing alerts. What I suspect you want to achieve is the behaviour when opening a template from the shell, which generates a "new" document based on the template. You can achieve this with the "Add" method thus;
Set wDoc = wApp.Documents.Add(Template:="file path here", NewTemplate:=False, DocumentType:=0)
If you indicate that the file is ReadOnly while setting the file name, and you turn off alerts, this should solve the issue of the prompt:
Set wApp = CreateObject("Word.Application")
wApp.DisplayAlerts = False
Set wDoc = wApp.Documents.Open Filename:="C:\Documents\SomeWordTemplate.dot", ReadOnly:=True
And when you go to save the file, just save it with the ".doc" file extension instead of ".dot" so its saved as a word file type. You can also change the file name and output directory path if you so choose. (Also, remember to turn the alerts back on)
With wDoc
.ActiveDocument.SaveAs Filename:="C:\Documents\NewWordDocumentFromTemplate.doc"
End With
wApp.DisplayAlerts = True
Hope this helps!
Trying to build a macro to copy data from Excel into MS Publsiher. I have the code for MS Word but it does not seem to work when applied to Publisher. It fails at this line appPub.ActiveWindow.Bookmarks("Growth").Paste
Word VBA:
Sub SendData()
Dim WordApp As Object
Set WordApp = CreateObject("Word.Application")
Dim ws As Worksheet
' Sheet1 is the codename for the sheet with the named range you want to copy,
' this is the name of the sheet in brackets in the VBAProject explorer, not the
' friendly name given on the worksheet tab itself visible to the end user.
Set ws = Sheet4
' This is the constant string which holds the filepath to your Word document
Const WORDDOC As String = "C:\Quarterly Reports - Word Version\Growth.docx"
WordApp.Visible = True
WordApp.Documents.Open WORDDOC
' Copies the named range "OrderRange" from the Excel book
'you are running this from.
ws.Range("Growth").Copy
' Pastes it to the bookmark "OrderBookmark" in your Word doc template.
WordApp.ActiveDocument.Bookmarks("Growth").Range.PasteAppendTable
' Sets your printer in Word to Adobe PDF and then prints the whole doc.
' WordApp.ActivePrinter = "Adobe PDF"
' WordApp.ActiveDocument.PrintOut
Set WordApp = Nothing
End Sub
Publisher VBA:
Sub SendDataPB()
Dim appPub As Object
Set appPub = CreateObject("Publisher.Application")
Dim ws As Worksheet
' Sheet1 is the codename for the sheet with the named range you want to copy,
' this is the name of the sheet in brackets in the VBAProject explorer, not the
' friendly name given on the worksheet tab itself visible to the end user.
Set ws = Sheet4
' This is the constant string which holds the filepath to your Publisher document
Const PublisherDOC As String = "C:\Quarterly Reports - Publisher Version\Growth.pub"
appPub.ActiveWindow.Visible = True
appPub.Open PublisherDOC
' Copies the named range "OrderRange" from the Excel book
' you are running this from.
ws.Range("Growth").Copy
' Pastes it to the bookmark "OrderBookmark" in your Publisher doc template.
appPub.ActiveWindow.Bookmarks("Growth").Paste
' Sets your printer in Publisher to Adobe PDF and then prints the whole doc.
' PublisherApp.ActivePrinter = "Adobe PDF"
' PublisherApp.ActiveDocument.PrintOut
Set appPub = Nothing
End Sub
ActiveWindow doesn't seem to contain any .Bookmarks collection: https://msdn.microsoft.com/EN-US/library/office/ff939707.aspx
Try ActiveDocument.Pages(YourPage).Shapes.Paste perhaps... With some luck that pastes your copied table as a new shape. From then on you'd just need to think of a clever way to place and find placeholders, unless you manage to find a usable Bookmarks collection somewhere else in the object model... Good luck!