MS Word VBA: Get document's attached template - vba

(Using Windows 10 and MS Word 2016. Global templates are: Normal.dotx and Autoload.dotm. Attached template to some docs is: Reference.dotx)
Hello everyone,
I'm having problems in VBA getting the attached template of a document.
I have a global template that loads when I load MS Word, called Autoload.dotm. But, for some specific documents, they use an attached template, which is not the global template (Autload.dotm) or the regular template (Normal.dotx). This attached template is called Reference.dotx.
So I use ActiveDocument.AttachedTemplate. But this returns Autoload.dotm, not Reference.dotx. I need to find out if the attached template defined in Developer->Document Template->Templates tab->Document Template is Reference.dotx. (Don't think it makes a difference, but the "Automatically update document styles" checkbox is checked.) Does anyone know how I can find if a document uses Reference.dotx? I don't need any of the global templates returned.
The code I'm using to try to get the attached template is simple:
If (ActiveDocument.AttachedTemplate = "Reference.dotx") Then
PrepareDocument_enabled = True
End If

Maybe this will help you? It will show the template used.
Sub Macro1()
Dim strPath As String
strPath = Dialogs(wdDialogToolsTemplates).Template
MsgBox strPath
End Sub
Otherwise, you can use this to change the template
Sub ChangeAttachedTemplate()
Dim oDoc As Document
Dim oTemplate As Template
Dim strTemplatePath As String
Set oDoc = ActiveDocument
If oDoc.Type = wdTypeTemplate Then Exit Sub
Set oTemplate = oDoc.AttachedTemplate
Debug.Print oTemplate.FullName
' Path is probably: C:\Users\USERNAME\AppData\Roaming\Microsoft\Templates\
If InStr(UCase(oTemplate.FullName), UCase("Path of the template")) > 0 Then
oDoc.AttachedTemplate = "PATH TO TEMPLATE" & "TEMPLATE NAME.dotm"
End If
End Sub

Related

Printing pdf through automating word with VB net without showing dialog

I've finally encountered a problem, where I didn't already find the answer here or anywhere else on the web:
My program grabs some measurement values from an instrument (I cannot directly control it so I have to wait until the measurement was done by the user and parse the report), calculates some derived values and shall put these values back into the pdf report, which was automatically generated by the instrument control software.
It all works until I come to the line where the printout is started. It always opens the word print dialog instead of silently overwriting my file. I actually don't understand what I am doing wrong when calling PrintOut.
Here is the example code:
Imports Microsoft.Office.Interop
Module Example
Private Sub PrintReport()
Dim intAnswer As Integer
Dim strReportFileName As String = ""
Dim appWord As New Word.Application
Dim wdDoc As Word.Document
dim strPPF as string = "0.5" 'For testing, normally a parameter
dim strFolder as string = "C:\UVVis-Data" 'For testing, normally a parameter
'Find and open the PDF file of the report:
strReportFileName = (From fi As IO.FileInfo In (New IO.DirectoryInfo(strFolder.GetFiles("*.pdf")) Order By fi.LastWriteTime Descending Select fi)(0).FullName 'It will be always the newest file in that folder
appWord.Visible = False 'hide word from the user
wdDoc = appWord.Documents.Open(strReportFileName) 'open the PDF report
'Replace the placeholders which were defined in the report template earlier:
With appWord.Selection.Find
.Text = "#PPF#"
.Replacement.ClearFormatting()
.Replacement.Text = strPPF
.Execute(Replace:=Microsoft.Office.Interop.Word.WdReplace.wdReplaceAll)
End With
'Print out the modified report:
'wdDoc.PrintOut(False, False,, strReportFileName,,,,,,, True) 'this was my first approach
wdDoc.PrintOut(Background:=False, Append:=False, OutputFileName:=strReportFileName, PrintToFile:=True) 'this also doesn't work as intended
'Close the file and restore word to it's normal state:
wdDoc.Close(Microsoft.Office.Interop.Word.WdSaveOptions.wdDoNotSaveChanges)
appWord.Visible = True
appWord.Quit()
End Sub
end Module
Use the Document.ExportAsFixedFormat method which saves a document as PDF or XPS format.
Public Sub ExportAsFixedFormat_Example()
wdDoc.ExportAsFixedFormat pbFixedFormatTypePDF, "pathandfilename.pdf"
End Sub
Thank you for the input.
I found a second problem with my code: I cannot overwrite the original document once it is open in word.
I solved this by first moving the pdf to a temporary folder, opening that temporary file in word and deleting it after word is closed.

Apply code to active document not document opened with Documents.Add

I got a VBA project from colleague who is retired.
I have to change a function:
Documents.Add Template:= _
"c:\word\Link.dot", _
NewTemplate:=False, DocumentType:=0
Here a new document (another Word file) is created with a template.
This template also relates data from another project "Common".
Basically, Documents.Add Template:= _"c:\word\Link.dot"
in Link.dot the Document_Open() is executed and the Common project is initialized.
Private Sub Document_Open()
Common.Initialize
End Sub
I don't want a second document opened by Documents.add, it should use the already active document.
I tried these two variants:
#1
Dim oDoc As Document
Set oDoc = ActiveDocument
oDoc.AttachedTemplate = "c:\word\Link.dot"
#2
ActiveDocument.AttachedTemplate = "c:\word\Link.dot"
Nothing happens to both of them, even no Runtime Error. I think it's because Document_Open() wasn't executed.
Document_Open() responds to the Open event. As you are not opening a document when attaching the template it will not execute.
You can execute the code directly though.
ActiveDocument.AttachedTemplate = "c:\word\Link.dot"
Common.Initialize

My access to word merge code is not working

I have made a form in access and I'm trying to code a "merge to word" button but my code has a problem and I dont know how to fix it.
Here's the code:
Private Sub Command102_Click()
Dim LWordDoc As String
Dim oApp As Object
'Path to the word document
LWordDoc = "C:\school\information tech\document.docx"
If Dir(LWordDoc) = "" Then
MsgBox "Document not found."
Else
'Create an instance of MS Word
Set oApp = CreateObject(Class:="Word.Application")
oApp.Visible = True
'Open the Document
oApp.Documents.Open FileName:=Document.docx
End If
End Sub
If someone could help that would be great. Ill attach screenshots of the error I get when I click the button and the code as the debugger is pointing to the problem. (pointing to the start of the "oApp.Documents.Open FileName:=Document.docx" line)
Thanks heaps
Since you create a variable to hold the filename, try using that:
oApp.Documents.Open FileName:=LWordDoc

VBA Excel - Unable to open existing Word Document file

I have a simple macro that opens a Word Document using Excel. I made sure the Word Object Library is properly referenced but when running this macro it freezes after Documents.Open is called (based on me seeing where it fails in the debugger). I don't know if it is a OLE Automation Error but the macro freezes and I have to force close Excel.
Public Const Dir = "C:/Temp/"
Public Const File = "temp.docx"
Public Sub OpenFile()
Dim f As String: f = Dir & File
Dim oWord As Object, oDoc As Object
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.Documents.Open(f)
oDoc.Visible = True
End Sub
I get this message as well: (even though there is no other application open)
Is there an alternative to opening a file with Excel and how I rewrite my program?
As requested - this is a common problem
You should change your Dir variable - that's a reserved name - and you're probably getting a Word error you can't see when you try to open that "file".
You should also change your File variable name too - that can be a reserved word too depending on references you've set
Added Comment:
With regard to it freezing - you can remove the oDoc.Visible = True statement and replace it with oWord.Visible = True BEFORE the problem statement Set oDoc = oWord.Documents.Open(f). That would popup the error indicating you had a problem with your filename

Opening a Lotus Note draft with Excel VBA, in order to replace just values

I'm trying to write a Excel VBA code which allows me to automatically create and send a Lotus Notes Email. The problem I face is the difficulty to create a rich text Email, so I think it would be easier to open a draft email, with a marker text which will be replaced (for exameple PASTE EXCEL CELLS HERE) and then just:
.GotoField ("Body")
.FINDSTRING "PASTE EXCEL CELLS HERE"'
and replace.
Any help on how to open a certain draft email? Perhabs something as .CreateDocument property?
Thank you very much!
Others have proposed interesting concepts, but the most robust approach would be to use HTML in a MIME enitity that is mapped to the Body Rich Text item. Using NotesSession..Convertmime = False you can build the body as HTML and then send the message. Based on the post by Joseph Hoetzl here, the LotusScript equivalent is this:
Sub Initialize()
Dim s As New NotesSession
Dim db As NotesDatabase
Dim stime as Single
Dim alog As New NotesLog("debug")
Call alog.OpenAgentLog()
stime = Timer
On Error GoTo eh
Dim doc As NotesDocument
Dim body As NotesMIMEEntity
Dim header As NotesMIMEHeader
Dim stream As NotesStream
Dim child As NotesMIMEEntity
Dim sendTo As String
Dim subject As String
s.Convertmime = False
sendto = s.Effectiveusername
subject = "Demo Message"
Set db= s.Currentdatabase
Set doc=db.Createdocument()
Set stream = s.CreateStream
Set body = doc.CreateMIMEEntity
Set header = body.CreateHeader({MIME-Version})
Call header.SetHeaderVal("1.0")
Set header = body.CreateHeader("Content-Type")
Call header.SetHeaderValAndParams({multipart/alternative;boundary="=NextPart_="})
'Add the to field
Set header = body.CreateHeader("To")
Call header.SetHeaderVal(SendTo)
'Add Subject Line
Set header = body.CreateHeader("Subject")
Call header.SetHeaderVal(subject)
'Add the body of the message
Set child = body.CreateChildEntity
Call stream.WriteText("<h1>Demo HTML Message</h1>")
Call stream.WriteText(|<table colspacing="0" colpadding="0" border="none">|)
Call stream.WriteText(|<tr><td>cell 1.1</td><td>cell 1.2</td><td>cell 1.3</td></tr>|)
Call stream.WriteText(|<tr><td>cell 2.1</td><td>cell 2.2</td><td>cell 2.3</td></tr>|)
Call stream.WriteText(|<tr><td>cell 3.1</td><td>cell 3.2</td><td>cell 3.3</td></tr>|)
Call stream.WriteText(|</table>|)
Call stream.WriteText(|<div class="headerlogo">|)
Call stream.WriteText(|<!-- ...some more HTML -->|)
Call child.setContentFromText(stream, {text/html;charset="iso-8859-1"}, ENC_NONE)
Call stream.Truncate 'Not sure if I need this
Call stream.Close
Call doc.CloseMIMEEntities(True)
Call doc.replaceItemValue("Form", "Memo")
Call doc.Send(False, sendTo)
es:
Exit Sub
eh:
Dim emsg$
emsg = Error & " at " & Erl & " in " & s.Currentagent.name
Call alog.logError(Err, emsg)
MsgBox "ERROR: " & Err & ": " & emsg
Resume es
End Sub
All of this should convert fairly easily to VBA in Excel. You can, of course be as complex as you want with your HTML.
The word "draft" is probably inappropriate here, but then again so is the word "template". Both have specific meanings in Lotus Notes that aren't what you really want. Users can delete drafts, and templates are an entirely different thing. So let's just call it a boilerplate message.
I would recomemnd creating a special mail database (NSF file) on the Domino server, which will just serve as a repository for your boilerplate. You can create a folder in that mail database called "Boilerplates". Using Domino Designer you can modify that folder's design so that the Subject column is the first column in the view, and it is sorted.
Once you have that done and you have created some boilerplates and saved them in the folder, you can use VBA to do a NotesSession.getDatabase call, NotesDatabase.getView call (this is used for folders as well as views), and then use NotesView.getDocumentByKey() to retrieve a specific boilerplate by the Subject you have assigned to it. Note that you do not have to copy this document to the user's mail database in order to mail it.
What you want to do is non-trivial, but you mention a draft email so there may be a workaround.
In your mail settings you can specify a signature file which can be an external html file on disk. So modify the signature file, then create your new mail which will then populate the body field the way you want it.
For sample code, within the memo form there should be a button to specify what signature file to use. You can use that as the baseline.
Rich text is not that hard to work with, but you need to look at the Domino Designer help, especially the classes NotesRichTextItem and NotesRichTextStyle. You also need to understand the DOM (Domino Object Model). Then you can create your mail content programatically.
Otherwise I think Richard's solution is the best, that you have a separate database where you get the rich text snippets, and use the AppendRTItem method of the NotesRichText class to put it into your email.
Thank you all guys!
But I found exactly what I wanted, without having to recreate the whole Email everytime:
Sub EditSelectedMail()
Dim NSession As Object
Dim NDatabase As Object
Dim NUIWorkspace As Object
Dim NUIdoc As Object
Set NSession = CreateObject("Notes.NotesSession")
Set NUIWorkspace = CreateObject("Notes.NotesUIWorkspace")
Set NDatabase = NSession.GetDatabase("", "")
If Not NDatabase.IsOpen Then NDatabase.OPENMAIL
Set NUIdoc = NUIWorkspace.EDITDOCUMENT(True)
With NUIdoc
'Find the marker text in the Body item
.GotoField ("Body")
.FINDSTRING "**PASTE EXCEL CELLS HERE**"
'Copy Excel cells to clipboard
Sheets("Sheet1").Range("A1:E6").Copy
'Create a temporary Word Document
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False
WordApp.Documents.Add
'Paste into Word document and copy to clipboard
With WordApp.Selection
.PasteSpecial DataType:=10
'Enum WdPasteDataType: 10 = HTML; 2 = Text; 1 = RTF
.WholeStory
.Copy
End With
'Paste from clipboard (Word) to Lotus Notes document
.Paste
Application.CutCopyMode = False
'WordApp.Quit SaveChanges:=False
Set WordApp = Nothing
End With
End Sub
I just select my "template", copy it into a new message, and then run the macro.