I am trying to use VBA in an open .docm file to open a 2nd read only .docx file and then insert -> object -> text from file (a 3rd read only .docx stored within the same folder).
The below code correctly opens and merges the two files but when it comes to saving the output it returns a Run-Time 13 “mismatch” error. My limited understanding leads me to believe that at the point where I am saving, the active document reference is still the original .docm and it is the .docx designation that then causes the conflict.
I am really struggling to manage the active document reference to avoid this. Presumably I am missing something very simple, all assistance is very gratefully received.
Documents.Open ActiveDocument.Path & "\DocA.docx", Visible:=True
Selection.InsertFile FileName:=ActiveDocument.Path & "\DocB.docx", Range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
ActiveDocument.SaveAs2 "C:\Users\" & Environ("UserName") & "\DocC" & ".docx", FileFormat:= _
wdFormatXMLDocument
ActiveWindow.Close
Putting flesh on John Korchok's comment:
Sub deleteme3()
Dim oldDoc As Document
Set oldDoc = Documents.Open(ActiveDocument.Path & "\DocA.docx", Visible:=True)
oldDoc.Activate
selection.Collapse Direction:=wdCollapseEnd 'to insert at end of document
selection.Range.InsertBreak Type:=wdPageBreak
Selection.EndKey Unit:=wdStory
Selection.InsertFile FileName:=ActiveDocument.Path & "\DocB.docx", range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
oldDoc.SaveAs2 "C:\Users\" & Environ("UserName") & "\DocC" & ".docx", FileFormat:= _
wdFormatXMLDocument
oldDoc.Close
Set oldDoc = Nothing
End Sub
Note this puts the inserted document at the end of the original document. You may want to use a next-page section break instead if there is header/footer differentiation. If you need that, please comment and I will include it.
There are a number of break types. Here is the enumeration of all of them if you are interested. The following types create a page break of one sort or another:
wdPageBreak (the default)
wdSectionBreakNextPage
wdSectionBreakOddPage (starts section on next odd-numbered page - good for chapters)
wdSectionBreakEvenPage (starts section on next even-numbered page - rarely used)
If wanting to preserve headers and footers additional code would be needed.
(Every section in a Word document has three headers and three footers, even if they are not displayed or used.)
' Break Link to Previous in newly added section for all of the headers and footers
Dim oHeaderFooter As HeaderFooter
Dim iCounter As Long
Let iCounter = ActiveDocument.Sections.Count
' break link in headers
For Each oHeaderFooter In ActiveDocument.Sections(iCounter).Headers
Let oHeaderFooter.LinkToPrevious = False
Next oHeaderFooter
' repeat for footers
For Each oHeaderFooter In ActiveDocument.Sections(iCounter).Footers
Let oHeaderFooter.LinkToPrevious = False
Next oHeaderFooter
Related
I need to loop over some word documents, and extract images from a word document and save them in a separate folder.
I've tried the method of saving them as an HTML document, but it is not a good fit for my requirement.
Now, I'm looping through the images using inlineshapes object and then copy-pasting them on a publisher document and then saving them as an image. However, I'm facing a Runtime Automation error when I'm running the script.
For using the Publisher runtime library I've tried both early and late binding but I'm facing the error on both of them.
Can anyone please let me know what is the problem? Also, if anyone can explain why I'm facing this error, that'd be great. As per my understanding, it is due to memory allocation, but I'm not sure.
Here is the code block that I've been working on (fp, dp are folder paths, while filename is the word document name. I'm calling this sub in another sub that is looping over all the files in a folder):
Sub test(ByVal fp As String, ByVal dp As String, ByVal filename As String)
Dim doc As Document
Dim pubdoc As New Publisher.Document
Dim shp As InlineShape
'Application.Screenupdating = False
'Dim pubdoc As Object
'Set pubdoc = CreateObject("Publisher.Document")
Set doc = Documents.Open(fp)
With doc
i = .InlineShapes.Count
Debug.Print i
End With
For j = 1 To i
Set shp = doc.InlineShapes(j)
shp.Select
Selection.CopyAsPicture
pubdoc.Pages(1).Shapes.Paste
pubdoc.Pages(1).Shapes(1).SaveAsPicture (dp & Application.PathSeparator & j & ".jpg")
pubdoc.Pages(1).Shapes(1).Delete
Next
doc.Close (wdDoNotSaveChanges)
pubdoc.Close
'Application.Screenupdating = True
End Sub
Apart from this, if anyone has any suggestions to make this faster, I'm all ears. Thanks in advance!
Just add .zip to the end of the file name, expand the file and look in the word/media folder. All the files will be there, no programming necessary.
Extracting the pictures from a Filtered HTML document that was created from your original source document would be faster. However, you said that was not a good fit for you needs so ... here is example code that will locate pictures in your source document and paste them into a second document.
The speed problem of this type of code is caused by the CopyPicture working from a Selection command, so I recommend using a range instead. Of course the For/Next loop that is required is slower no matter what.
Sub CopyPasteAsPicture()
Dim doc As Word.Document, iShp As Word.InlineShape, shp As Word.Shape
Dim i As Integer, nDoc As Word.Document, rng As Word.Range
Set doc = ActiveDocument
If doc.Shapes.Count > 0 Then
For i = 1 To doc.Shapes.Count
Set shp = doc.Shapes(i)
If shp.Type = msoLinkedPicture Or shp.Type = msoPicture Then
'if you want only pictures extracted then you have
'to specify the type
shp.ConvertToInlineShape
'if you want all extracted pictures to be in the sequence
'they appear in the document then you have to convert
'floating shapes to inline shapes
End If
Next
End If
If doc.Content.InlineShapes.Count > 0 Then
Set nDoc = Word.Documents.Add
Set rng = nDoc.Content
For i = 1 To doc.Content.InlineShapes.Count
doc.Content.InlineShapes(i).Range.CopyAsPicture
rng.Paste
rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
rng.Paragraphs.Add
rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
Next
End If
End Sub
If you want to place all shapes (floating or inline) into a folder as image files, then the best way is to save the source document as a filtered HTML document. Here is the command:
htmDoc.SaveAs2 FileName:=LGPWorking & strFileName, AddToRecentFiles:=False, FileFormat:=Word.WdSaveFormat.wdFormatFilteredHTML
In the above the active document is assigned to the variable htmDoc. I am giving this new document a specific name and location. The output from this is not only the HTML file but also a directory by the same name with an appended "_Files" label. In the "x_Files" directory are all the image files.
If you only want selective images pulled from your original source document, or if you want images pulled from multiple source documents ... then you need to use the above code that I shared for placing only the images you want from one or more source document into a new Word document and then save that new document as an Filtered HTML.
When your routine is done, you can Kill the HTML document and only leave the Files directory.
I had to change a few things around, but this will allow to save a single image on a word document and go through a couple of cycles before it turns into a jpg on the other side, without any white space
filename = ActiveDocument.FullName
saveLocaton = "z:\temp\"
FolderName = "test"
On Error Resume Next
Kill "z:\temp\test_files\*" 'Delete all files
RmDir "z:\temp\test_files" 'Delete folder
ActiveDocument.SaveAs2 filename:="z:\temp\test.html", FileFormat:=wdFormatHTML
ActiveDocument.Close
Kill saveLocaton & FolderName & ".html"
Kill saveLocaton & FolderName & "_files\*.xml"
Kill saveLocaton & FolderName & "_files\*.html"
Kill saveLocaton & FolderName & "_files\*.thmx"
Name saveLocaton & FolderName & "_files\image00" & 1 & ".png" As saveLocaton & FolderName & "_files\" & test2 & "_00" & x & ".jpg"
Word.Application.Visible = True
Word.Application.Activate
I have an MS Word document with macros (.docm)
Based on many StackOverflow posts, I've written a macro to export as a pdf and save as a .docx
I open/edit the .docm document, that has an onSave macro that saves the document in .pdf format and .docx format which I distribute for other people to use. I will always be making my changes to the .docm document.
My issue is that doing so converts the active(open) document from .docm to .docx such that I'm no longer making my changes to the .docm.
Sub SaveActiveDocumentAsDocx()
On Error GoTo Errhandler
If InStrRev(ActiveDocument.FullName, ".") <> 0 Then
Dim strPath As String
strPath = Left(ActiveDocument.FullName, InStrRev(ActiveDocument.FullName, ".") - 1) & ".docx"
ActiveDocument.SaveAs2 FileName:=strPath, FileFormat:=wdFormatDocumentDefault
End If
On Error GoTo 0
Exit Sub
Errhandler:
MsgBox "There was an error saving a copy of this document as DOCX. " & _
"Ensure that the DOCX is not open for viewing and that the destination path is writable. Error code: " & Err
End Sub
I can find no parameter to prevent this conversion of the active document in either "saveas" or "saveas2"
Furthermore, after the "saveas" command, any additional lines in the original macro are not executed because the active document no longer contains macros. I tried adding lines to the macro to reopen the original .docm and then close the .docx but those commends never execute.
I'm hoping I'm just missing something simple?
Sub SaveAMacrolessCopyOfActiveDocument()
' Charles Kenyon 2 October 2020
' Save a copy of active document as a macrofree document
'
Dim oDocument As Document
Dim oNewDocument As Document
Dim iLength As Long
Dim strName As String
Set oDocument = ActiveDocument ' - saves a copy of the active document
' Set oDocument = ThisDocument '- saves copy of code container rather than ActiveDocument
Let iLength = Len(oDocument.Name) - 5
Let strName = Left(oDocument.Name, iLength)
Set oNewDocument = Documents.Add(Template:=oDocument.FullName, DocumentType:=wdNewBlankDocument, Visible:=False)
oNewDocument.SaveAs2 FileName:=strName & ".docx", FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=15
oNewDocument.Close SaveChanges:=False
' Clean up
Set oDocument = Nothing
Set oNewDocument = Nothing
End Sub
The above code creates and saves a copy of the ActiveDocument with the same name but as a .docx formatted document (macro-free). The visible property in the .Add command means that it will not appear on screen and it is closed by the procedure. The new document will appear in Recent documents.
I'm a total VBA noob and need a little help. If it matters I'm using Microsoft Word 2016 on a Mac. I'm using mail merge to create a word doc, and need to split the resulting word doc into multiple pages based on section breaks. I found this page with VBA code to split the pages and it works great. The only issue I'm having is it's saving to a random place on my computer (I have no idea how it's deciding where to save). Here's the code I'm working with:
Sub BreakOnSection()
' Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection
'A mail merge document ends with a section break next page.
'Subtracting one from the section count stop error message.
For i = 1 To ((ActiveDocument.Sections.Count) - 1)
'Note: If a document does not end with a section break,
'substitute the following line of code for the one above:
'For I = 1 To ActiveDocument.Sections.Count
'Select and copy the section text to the clipboard.
ActiveDocument.Bookmarks("\Section").Range.Copy
'Create a new document to paste text from clipboard.
Documents.Add
Selection.Paste
' Removes the break that is copied at the end of the section, if any.
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
ChangeFileOpenDirectory "C:\"
DocNum = DocNum + 1
ActiveDocument.SaveAs fileName:="test_" & DocNum & ".doc"
ActiveDocument.Close
' Move the selection to the next section in the document.
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub
I see the ChangeFileOpenDirectory is set to "C:\" which isn't right for a mac, but what would I need to change to have it ask me where to save all the resulting docs? I don't want to select a folder for each individual doc, but rather select one folder for all of the docs to save into and let it run.
Thanks in advance for the help, I've tried a few hours of google and am still unsure on this one.
I have not tested this on a mac but it should be
Dim mySaveLocation As String
Dim dlg As FileDialog
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
dlg.AllowMultiSelect = False
dlg.Show
mySaveLocation = dlg.SelectedItems.Item(1)
and then when you save it
ActiveDocument.SaveAs fileName:= mySaveLocation & "\test_" & DocNum & ".doc"
I have a document with comments on a long interview transcript. I found a Macro on SO that let's me export those comments with the highlighted text. This is awesome but the output is terribly dull (plain text).
I need to know if and how to apply bold, italic and insert newlines. I have looked for like an hours now and because my VBA is terrible I have no reference for where to look other than keyword searches on "marco output formatting"
Does someone know how to take the below script and font changes to parts of the text?
Sub ExportComments()
Dim s As String
Dim cmt As Word.Comment
Dim doc As Word.Document
For Each cmt In ActiveDocument.Comments
s = s & "Text: " & cmt.Scope.FormattedText & " -> "
s = s & "Comments: " & cmt.Initial & cmt.Index & ":" & cmt.Range.Text & vbCr
Next
Set doc = Documents.Add
doc.Range.Text = s
End Sub
Maybe I can do it with HTML interpreted by Word?
I'm assuming that the formatting you want included is already within the comment text, and that you are just looking for a way to get that into your final document. Here is a modified version of your script that will do that (with one caveat, listed below):
Sub ExportComments()
Dim cmt As Comment
Dim newdoc As Document
Dim currDoc As Document
Set currDoc = ActiveDocument
Set newdoc = Documents.Add
currDoc.Activate
For Each cmt In currDoc.Comments
With newdoc.Content
cmt.Scope.Copy
.InsertAfter "Text: "
.Collapse wdCollapseEnd
.Paste
.InsertAfter " - > "
cmt.Range.Copy
.InsertAfter "Comments: " & cmt.Initial & cmt.Index & ":"
.Collapse wdCollapseEnd
.Paste
.InsertParagraphAfter
End With
Next
End Sub
The difference here is that I'm using Copy and Paste rather than generating text strings.
Caveat: As the macro is written right now, any character formatting from the Scope (the text that appears next to Text in your file) will be applied to the arrow and the initials as well. This is pretty easy to fix with a search and replace, so I didn't incorporate it into the script.
I have Word survey files, each containing forms filled by subjects. Until now I have manually exported the forms data by saving as txt and choosing the option "save form data as delimited text file".
I want to programmatically save as delimited text file all the .doc documents in a given directory. Alternatively, if this were to be too complicated, it would be sufficient to save one file at a time. The new txt files must have the same name as the original .doc files.
Thanks for your input Jan Schejbal. I've reached a solution with this piece of code, so I share it for whose who encounter the same problem. I received help from here
Sub Save_Forms_Data()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document, strDocName As String
strFolder = CurDir
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
strDocName = Left(.FullName, InStrRev(.FullName, ".")) & "txt"
.SaveAs2 FileName:=strDocName, FileFormat:=wdFormatText, AddToRecentFiles:=False, _
SaveFormsData:=True, Encoding:=1252, InsertLineBreaks:=False, LineEnding:=wdCRLF
.Close SaveChanges:=False
End With
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
Application.Quit SaveChanges:=wdDoNotSaveChanges
End Sub
You can record a macro, which means you start the recording, do certain actions, then stop the recording, and VBA code for said actions is automatically generated. The code may not be very clean, but it should give you a good start to show you how the syntax looks and what commands you need for your actions. For certain things (e.g. dynamically specifying the file name), you will need to consult the documentation, but if you have any programming experience in any common language, this should not pose a significant problem once you have the "skeleton" provided by the macro recorder.
The more you want to automate, the more VBA you will need to learn. As VBA really isn't difficult, and it seems like you have a lot of repetitive work in front of you if you don't automate it, I'd suggest you learn it and Google what you need. This way, you will get your work done in a similar timeframe (or less, especially if this is not just a one-off thing), you will have a macro to do it next time, it will be less boring, and you will have learned a bit of VBA.