Populate Word from Access & Age calculation

[Sumilidon]

Hello all,



Apologies for what will be a blatent newbie question but I have exhausted all the youtube videos and posts I can find to no avail for that I am after.

In short, I have a record selected on a form in front of me. I have a Word file with my template and bookmarks defined and I want to press a button which will populate that template with just that record. (All the guides seem to focus on producing letters for every entry in your database). I need it to be output to Word, I can't use a report.

Ideally, I would like the Word document to be opened, populated and left open for me to save it somewhere specific.

Second question is how do I create a field which calculates an age? I have a field that states the date it was created, a field that states the date it was closed. I would like the calculated field to display either today's date minus the creation date, or the closed date minus the creation date (if a closed date exists)

[June7]

Mail merge can be done with a filtered dataset. Steps described in https://support.microsoft.com/en-us/...b-5c8a34c7e89d can be programmed in VBA. I seem to remember mail merge has issue with calculated fields.

Another tutorial on mail merge http://kallal.ca/wordmerge/index.html

Alternative to mail merge is Word automation with VBA. https://www.microsoftaccessexpert.co...utomation.aspx

Calculating age can actually be rather tricky. How precise do you want it - rounded to nearest yr, month, week, day? Many discussions on this topic.

[Gicu]

For the age (seems like you want the number of days the entity your are recording was opened):

AgeInDays:Iif(isNull([DateClosed]),Date(),[DateClosed])-[CreationDate]

I do not use bookmarks for mail-merge as that is not really using the Word mail-merging capabilities. Have a look at the code I use to export the selected record to a delimited text file and use that as the source for the Word mail-merge template (you will need to adjust the code to match your object names).

Private Sub cmdPrintCurrentRecord_Click()
Dim ReadOnlyMode As Boolean, strDocument As String


strDocument = Me.txtPathToYourWordDocument 'uses a text box on your form to get the full name of the Word mail-merge template or use a dlookup to get it from a settings table
If Dir(strDocument) = "" Then
    MsgBox strDocument & " not found!", vbInformation, "Document not found!"
    Exit Sub
End If
response = MsgBox("Do you wish to generate a Read-Only Mail Merge document using " & Chr(13) & _
        strDocument & Chr(13) & Chr(13) & _       
        Chr(13) & Chr(13) & "Select YES for Read-Only" & _
        Chr(13) & "Select NO for Read-Write" & _
        Chr(13) & "Select CANCEL to halt.", vbYesNoCancel + vbQuestion, "Generate a Mail Merge Document")


If response = vbCancel Then Exit Sub


If response = vbYes Then
    ReadOnlyMode = True
Else
    ReadOnlyMode = False
End If
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>


Dim iFileCount As Integer
Dim strMailMergeFolder as string


strMailMergeFolder = CurrentProject.path
vcKillMailMerge
If Right(strMailMergeFolder, 1) <> "\" Then strMailMergeFolder = strMailMergeFolder & "\"
iFileCount = 1
On Error GoTo Error_Kill
Kill_File:
If Len(Dir(strMailMergeFolder & "DB_MailMerge" & iFileCount & ".txt")) > 0 Then Kill strMailMergeFolder & "DB_MailMerge" & iFileCount & ".txt"
GoTo relink


Error_Kill:
iFileCount = iFileCount + 1
GoTo Kill_File


relink:
     DoCmd.TransferText acExportDelim, , "qryYourQueryForCurrentID", strMailMergeFolder & "DB_MailMerge" & iFileCount & ".txt", True
     RelinkDocMailMergeText strMailMergeFolder & "DB_MailMerge" & iFileCount & ".txt", strDocument, ReadOnlyMode
     


'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>


End Sub


Sub RelinkDocMailMergeText(strMailMergeFileName As String, strDoc As String, boReadOnlyMode As Boolean)
Dim WordApp As Object
Dim retcode
Dim strFileName
Dim sPathNotmalTemplate
'On Error Resume Next




strFileName = strDoc


If Dir(strFileName) = "" Then
    MsgBox strFileName & " was not found!  Is it hidden?", vbExclamation, "Document not in this folder!"
    Exit Sub
End If




Set WordApp = CreateObject("Word.Application")
         
With WordApp


          .Application.Visible = True
          On Error GoTo telluser
          .StatusBar = "Preparing to add a new Mail-Merge document in Word format.  Please wait..."
          
          .Documents.Open strFileName, ReadOnly:=boReadOnlyMode, AddToRecentFiles:=False, Revert:=True


    .ActiveDocument.MailMerge.OpenDataSource Name:= _
        strMailMergeFileName, ConfirmConversions:=False, ReadOnly:= _
        boReadOnlyMode, LinkToSource:=True, Revert:=True, AddToRecentFiles:=False
    .NormalTemplate.Saved = True
    .ActiveDocument.MailMerge.ViewMailMergeFieldCodes = False
    .ActiveDocument.MailMerge.DataSource.ActiveRecord = -4 'first record
    .ActiveDocument.MailMerge.Destination = 0    'new record
    .ActiveDocument.MailMerge.Execute
    .Documents(1).Printout 'print merged doc
    .Documents(1).Close 0 'wdDoNotSaveChanges  close merged doc
    .ActiveDocument.Close 0 'close mail-merge template
End With
Set WordApp = Nothing
Exit Sub


telluser:
Set WordApp = Nothing
MsgBox "An error occurred while attempting to open a Mail-Merge document:" & Chr(13) & strFileName, vbExclamation, "Add New Mail-Merge Document"
End Sub








Public Sub vcKillMailMerge()
    Dim strFileName As String
    Dim iFolderCount As Integer
    Dim strFolders() As String
    Dim i As Integer
    Dim strFolder As String, strFilePattern As String
    
    On Error Resume Next
    
    strFolder = CurrentProject.path
    strFilePattern = "*DB_MailMerge*"
     'Collect child folders
    strFileName = Dir$(strFolder & "\", vbDirectory)
    Do Until strFileName = ""
        If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then
            If Left$(strFileName, 1) <> "." Then
                ReDim Preserve strFolders(iFolderCount)
                strFolders(iFolderCount) = strFolder & "\" & strFileName
                iFolderCount = iFolderCount + 1
            End If
        End If
        strFileName = Dir$()
    Loop
     'process files in current folder
    strFileName = Dir$(strFolder & "\" & strFilePattern)
    Do Until strFileName = ""
        '*******************************************
        Kill strFolder & "\" & strFileName
         '*******************************************
        strFileName = Dir$()
    Loop
End Sub

Cheers,