I have a longer code and in the final part there is an ActiveX button for saving and closing the file. Also, for efficiency, I've added an vbYesNo command for creating a new document based on the template in use.
The code:
Sub macrosave ()
Dim doc As Document
Dim strDosar As String
Dim Ret As Variant
Set doc = Application.ActiveDocument
strDosar = Range.Paragraphs(1).Range.Text
Ret = MsgBox("Do you want to create a new document?", vbYesNo)
If Ret = vbYes Then
Documents.Add Template:=ActiveDocument.AttachedTemplate.Path & Application.PathSeparator & ActiveDocument.AttachedTemplate.Name
End If
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument = 0
doc.Close
End Sub
If I click yes, a new document is created, the last one is saved and closed afterwards.
If I click no, the active document is saved, but it is not closed afterwards.
I suspect it has something to do with the file format (wdFormatDocument) because this way it eliminates all VBA codes.
The file format is needed because I want to get rid of all content controls after saving the file.
Why doc.Close is not being executed in the second case and what are my options in order to achieve the purpose?
This argument is invalid:
FileFormat:=wdFormatDocument = 0
Perhaps:
Sub macrosave()
Dim doc As Document, strDosar As String, Ret As Variant
Set doc = ActiveDocument
strDosar = Split(doc.Range.Paragraphs(1).Range.Text, vbCr)(0)
Ret = MsgBox("Do you want to create a new document?", vbYesNo)
If Ret = vbYes Then Documents.Add Template:=doc.AttachedTemplate.FullName
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument
doc.Close False
End Sub
I believe the problem comes from a disagreement between the file extension - doc and the specified file format wdFormatDocument.
Starting with Word 2007 the default file format (wdFormatDocument) refers to the Word Open XML file format, docx. To save as the doc file format requires using wdFormatDocument97. The reason it may have intermittently worked is because the numerical value of this enumeration is 0.
Try
doc.SaveAs "\\server\Public\" & strDosar & ".doc", FileFormat:=wdFormatDocument97
Or change the extension to docx
doc.SaveAs "\\server\Public\" & strDosar & ".docx", FileFormat:=wdFormatDocument
However docx will not remove the content controls the next time the document is opened. (The doc format will because content controls were introduced at the same time as the new file format, so they aren't supported in the old format.)
If the additional purpose is " it eliminates all VBA codes" then it would make sense to change the attached template before closing the document to Normal.dotm. This removes the link to the attached template and has the added advantage that the document will "find" its template no matter who opens it, later. (When the attached template is not present it can delay opening by a considerable time under some circumstances.)
doc.AttachedTemplate = NormalTemplate
Note that it will also make things simpler to pick up the file path using the FullName poperty of the template:
Documents.Add Template:=ActiveDocument.AttachedTemplate.FullName
Related
I've tried to use the below code which I found on this conversation How To Search And Replace Across Multiple Files In Word? supplied by Charles Kenyon. However, it doesn't seem to work for me. I've enabled macros on my word and added the below code as a new module in Macros. When I go to replace all, it'll replace the text as per normal, but after doing this, when I open up the other macros enabled word doc, I find that the same text is still in these docs, without being replaced. Am I doing something wrong? Namely, I also wish to add a wildcard entry into my replace all, will the below code work or can someone suggest a better alternative? I have tested the below code with and without wildcard entries to no avail. I've also tried the code on this page in my macros but it also didn't work How to find and replace a text in multiple Word documents using VBAThanks for any help!
Option Explicit
Public Sub BatchReplaceAll()
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long
PathToUse = "C:\Test\"
'Error handler to handle error generated whenever
'the FindReplace dialog is closed
On Error Resume Next
'Close all open documents before beginning
Documents.Close SaveChanges:=wdPromptToSaveChanges
'Boolean expression to test whether first loop
'This is used so that the FindReplace dialog will
'only be displayed for the first document
FirstLoop = True
'Set the directory and type of file to batch process
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
'Open document
Set myDoc = Documents.Open(PathToUse & myFile)
If FirstLoop Then
'Display dialog on first loop only
Dialogs(wdDialogEditReplace).Show
FirstLoop = False
Response = MsgBox("Do you want to process " & _
"the rest of the files in this folder", vbYesNo)
If Response = vbNo Then Exit Sub
Else
'On subsequent loops (files), a ReplaceAll is
'executed with the original settings and without
'displaying the dialog box again
With Dialogs(wdDialogEditReplace)
.ReplaceAll = 1
.Execute
End With
End If
'Close the modified document after saving changes
myDoc.Close SaveChanges:=wdSaveChanges
'Next file in folder
myFile = Dir$()
Wend
End Sub
I am not a programmer so not sure what to do here. I would like an option of adding an image file in a Microsoft Word document userform for MAC. I had used a code earlier which works perfectly in Windows but it doesnt work for MAC and gives a 5948 error. I had added a field for the image in the userform with a button to add the image and the final submit button. The add button should allow the user to insert any size image from the local folder.
The code I was using is given below:
Dim ImagePath As String
Private Sub CMDAddImage_Click()
Dim objFileDialog As Office.FileDialog
Set objFileDialog = Application.FileDialog(MsoFileDialogType.msoFileDialogFilePicker)
With objFileDialog
.AllowMultiSelect = False
.ButtonName = "File Picker"
.Title = "File Picker"
If (.Show > 0) Then
End If
If (.SelectedItems.Count > 0) Then
Call MsgBox(.SelectedItems(1))
ImagePath = .SelectedItems(1)
End If
End With
Image1.Picture = LoadPicture(ImagePath)
End Sub
And the code in submit button was:
Dim objWord
Dim objDoc
Dim objShapes
Dim objSelection
'Set objSelection = ActiveDocument.Sections
'objSelection.TypeText (vbCrLf & "One Picture will be inserted here....")
ActiveDocument.Bookmarks("Field04").Select
Set objShapes = ActiveDocument.InlineShapes
objShapes.AddPicture (ImagePath)
End
End Sub
Can someone please help me edit the code for mac. In mac it does not allow to add the file.
You should check out the suggestion made by #JohnKorchok in a comment to your previous question - insert an image Content Control in your document instead, and throw away the VBA.
But if you need to keep using VBA and a UserForm...
Application.FileDialog is not available on Mac.
Application.GetOpenFileName is not avaialble from Word (it's an Excel thing).
Application.Dialogs does not do the same thing as GetOpenFileName so the user experience will be rather different, but at its simplest, you can use it like this:
With Application.Dialogs(wdDialogFileOpen)
' .Display = -1 for "OK" ("Open" in this case)
' .Display = 0 for "Cancel"
' (THere are other possible return values
' but I do not think they are applicable here)
If .Display = -1 Then
ImagePath = .Name
End If
End With
or if you prefer, the lengthier
Dim dlg As Word.Dialog
Set dlg = Application.Dialogs(wdDialogFileOpen)
With dlg
If .Display = -1 Then
ImagePath = .Name
End If
End With
Set dlg = Nothing
However, this dilaog does not let you specify file types or any kind of filtering, a starting folder etc. Attempts to set Finder search criteria via something like
.Name = "(_kMDItemFileName = ""*.jpg"")"
.Update
before the .Display either can't work or need different syntax.
Further, the Apple dialog may start with its
own filtering set up so the user will have to click Options to enable All Files. You don't know what file type the user will choose so you will need to deal with that.
An alternative is to invoke Applescript. For this, it appears that you can still use the VBA MacScript command, which means that you can put all the script in your VBA file. If that does not work, then unfortunately you have to use AppleScriptTask which would require you to work some more on the Script and install the script in the correct folder on every Mac where you need this feature.
Here's the code I used - you would probably need to wrap everything up in another function call and use conditional compilation or other tests to call the correct routine depending on whether the code is running on Mac or Windows
Private Sub CMDAddImage_Click()
Dim s As String
Dim sFileName As String
On Error Resume Next
s = ""
' set this to some other location as appropriate
s = s & "set thePictureFoldersPath to (path to pictures folder)" & vbNewLine
s = s & "set applescript's text item delimiters to "",""" & vbNewLine
s = s & "set theFile to ¬" & vbNewLine
' add the image file types you want here
s = s & "(choose file of type {""png"",""jpg""} ¬" & vbNewLine
s = s & "with prompt ""Choose an image to insert."" ¬" & vbNewLine
s = s & "default location alias thePictureFoldersPath ¬" & vbNewLine
s = s & "multiple selections allowed false) as string" & vbNewLine
s = s & "set applescript's text item delimiters to """"" & vbNewLine
' choose file gives as an AFS path name (with colon delimiters)
' get one Word 2016/2019 will work with
s = s & "posix path of theFile"
sFileName = MacScript(s)
If sFileName <> "" Then
' Maybe do some more validation here
ImagePath = sFileName
Image1.Picture = LoadPicture(ImagePath)
End If
End Sub
I want to generate an automatic footer when I save a new MS Word file, and update the footer if I SaveAs the file.
The code below used to work well with an old Word. With the latest Word it only works if I press F12 on the keyboard. Any help would be greatly appreciated!
Sub FileSaveAs()
Dialogs(wdDialogFileSaveAs).Show
Dim i As Long
Dim ThisPath As String
Dim pName As String
Dim TextInFooter As String
Dim FullName As String
ThisPath = ActiveDocument.Path
pName = ActiveDocument.Name
FullName = ThisPath & "\" & pName
TextInFooter = "This file was saved in: " & FullName & " on the " & Now
For i = 1 To ActiveDocument.Sections.Count
With ActiveDocument.Sections(i)
.Footers(wdHeaderFooterPrimary).Range.Text = TextInFooter
End With
Next
End Sub
As you noticed, the new version triggers the FileSaveAs only on F12. Not sure if this is bug or a feature.
If it is only important that the document shows the information in print or on open - my suggested workaround:
You could avoid the insertion into the footer on save and insert it using fields, the document already has the information you are inserting. You simply need to make it visible. The footer would be then:
This file was saved as { FILENAME \p } the { SAVEDATE \# "dd.MM.yyyy HH:mm:ss"}
Adjust the Date/Time format as needed. You have to force the update of the fields - this is where the auto macros come into it.
Sub AutoOpen()
' set fields to update before printing (if saved as and printed while open)
Options.UpdateFieldsAtPrint = True
' Update all current fields in just opened document
ActiveDocument.Fields.Update
End Sub
Sub AutoClose()
' update fields when closing
ActiveDocument.Fields.Update
End Sub
The only difference would be, that you have the full path including file name and extension there. Additionally, there might be times, when the file is saved but not yet opened/closed/printed and has also not updated the fields.
In theory, you could insert the footer into the document with the AutoOpen macro as well (activedocument.fields.add).
I'm trying to add a few custom document properties to a folder of word documents.
I know that the loop itself works fine, because I used the same loop with different code to modify and then update pre-existing custom document properties.
The code to add custom document properties also works, I tested it by running it in it's own macro for a single document, which worked fine.
Since the loop works and the code within the loop also works, I just can't figure out what's wrong with it.
Here's the code:
Sub add_custom_docproperties()
Dim file
Dim path As String
Dim filepath As Variant
filepath = InputBox("Please enter the filepath for the files you want to
update.", "Input Filepath", "Copy filepath here...")
Select Case StrPtr(response)
Case 0
endednotification = MsgBox("The macro has been ended.", , "Notification")
Exit Sub
Case Else
End Select
path = filepath & "\"
file = Dir(path & "*.*")
'Application.ScreenUpdating = False
Do While file <> ""
Documents.Open FileName:=path & file
Check = MsgBox(path & file, , "Check")
ActiveDocument.CustomDocumentProperties.Add Name:="firstdocprop",
_LinkToContent:=False, Type:=msoPropertyTypeString, Value:="The First One"
ActiveDocument.CustomDocumentProperties.Add Name:="seconddocprop",
_LinkToContent:=False, Type:=msoPropertyTypeString, Value:="Second"
ActiveDocument.CustomDocumentProperties.Add Name:="thirddocprop",
_LinkToContent:=False, Type:=msoPropertyTypeString, Value:="Third"
'original example from:
'https://msdn.microsoft.com/en-us/vba/office-shared-vba
/articles/documentproperties-add-method-office
ActiveDocument.Save
ActiveDocument.Close
'set file to next in Dir
file = Dir()
Loop
'Application.ScreenUpdating = True
MsgBox "The macro is complete."
End Sub
As you can see I have a comment there with the first example I tried from msdn, which I modified.
Thanks in advance for any help, even if you could just point me to a resource explaining where I've gone wrong or something like that.
Word does not recognise the changes to the CustomDocumentProperties as being sufficiently important to actually save the document when you execute the Save command - unless you had made other changes it just decides to ignore the Save.
You can force a save by telling Word that the document has not been saved since it was last changed:
ActiveDocument.Saved = False
ActiveDocument.Save
ActiveDocument.Close
Say you want to have a button that the user can click and save a copy of the current file as a PDF(Documentation):
Application.ActiveDocument.SaveAs2 fileName:="fileName.pdf", FileFormat:=wdFormatPDF
This works fine, the user is presented with a save dialog, selects a location and the file is saved, however a few things are not correct:
The type displayed does not match what was specified in the VBA, how can this be correct? It still saves as type "PDF" without issue, even after showing "DOCX" as the file type in the "Save as Type" drop down. Also the "fileName.pdf" is not placed in the "File Name" box, its as if the dialog box is unaware of the options set in the VBA code(This same issue is also referenced in this post).
UPDATE 1
After taking a second look at my code I now realize that the SaveAs2 Method was not displaying the dialog menu, the correct version of the code(simplified) can be described as:
Dim selected As String: selected = Application.FileDialog(msoFileDialogSaveAs).Show()
Dim filePath As String
If selected <> 0 Then
filePath = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
Application.ActiveDocument.SaveAs2 fileName:=Split(filePath, ".")(0), FileFormat:=wdFormatPDF
End If
So then the real question(I guess) is how do you get "Application.FileDialog" to display the proper type you wish to save in under the "Save as type" drop down, and this has already been answered by #PatricK. Thanks everyone for the help, I apologize for the initial confused nature of this question.
I am surprised for SaveAs2 will bring you a prompt to be honest - Only a new document and .Save will bring you that prompt.
If you want to get something similar to that prompt, you use Application.FileDialog with type msoFileDialogSaveAs.
Use this code below (perhaps as an AddIn suits more):
Option Explicit
Sub MySaveAs()
Dim oPrompt As FileDialog, i As Long, sFilename As String
Set oPrompt = Application.FileDialog(msoFileDialogSaveAs)
With oPrompt
' Find the PDF Filter from Default Filters
For i = 1 To .Filters.Count
'Debug.Print i & " | " & .Filters(i).Description & " | " & .Filters(i).Extensions
' Locate the PDF filter
If InStr(1, .Filters(i).Description, "PDF", vbTextCompare) = 1 Then
.FilterIndex = i
Exit For
End If
Next
' Change the title and button text
.Title = "Saving """ & ActiveDocument.Name & """ to PDF format"
.ButtonName = "Save to PDF"
' Default name
.InitialFileName = ActiveDocument.Name
' Show the Prompt and get Filename
If .Show = -1 Then
sFilename = .SelectedItems(1)
Debug.Print "Final filename: " & sFilename
' Save the file as PDF
ActiveDocument.SaveAs2 sFilename, wdFormatPDF
End If
End With
Set oPrompt = Nothing
End Sub
Screenshot sample: