Link to home
Start Free TrialLog in
Avatar of yohot
yohot

asked on

MS Access Report to MS Word

Hello,  

I have been racking my brain in VBA.  have a form that generates an Access report nicely.  However,  I would prefer it in MS word as the document is routed in Sharepoint late for further editing.  

Three things I am trying to do.

1. I would like to export data from an active form to a predefined MS word template.  (*.docx format,  RTF drops formatting, so I use a template)

2. save the created active word document with the file name set to a specific field name from that report.  

3.  Upload "Save As."   [field name].docx to a sharepoint directory.  

I can do this with a macro as an RTF format but need to preserve formatting.     Stuck.  

I can provide examples of my database if you like?  

Thanks in advance, Troy
ASKER CERTIFIED SOLUTION
Avatar of als315
als315
Flag of Russian Federation image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of yohot
yohot

ASKER

Thank you for the reply.    However,  it is only part of what I am looking for.  I am able to create a *dotx template with bookmarks and write information to that New Document...    I am also looking for Code that would allow me to write the document to a sharepoint directory.
You can add command like this:
ActiveDocument.SaveAs "http://YourSharepointServerURL/DocumentsFolder/" & ActiveDocument.Name, FileFormat:=Word.WdSaveFormat.wdFormatDocumentDefault, AddToRecentFiles:=True

Open in new window

Avatar of yohot

ASKER

3 things happen wrong.

1.  The code opens the template and inserts data vs.  opening a "new" document from the template.  So what I get is my template gets data written overtop of it  lokoing for Ceate New from template...   if I save then next run I get the same data twice in the same field.  and so forth...

2. Does not upload to the site.  
3. Would like the ActiveDocument.Name  to be the QA_Work_Order field from Database.

here is code so far.   Thanks, Troy


Private Sub CriticalNC_Click()
Dim objWord As Word.Application

    'Copy the NC Record on the Review Details form.
    DoCmd.GoToControl "QA Work Order"
    DoCmd.RunCommand acCmdCopy

    'Start Microsoft Word 2007.
    Set objWord = CreateObject("Word.Application")

    With objWord
        'Make the application visible.
        .Visible = True

        'Open the document.
        .Documents.Open ("C:\SPL\NC_Audit_review.dotx")

        'Move to each bookmark and insert text from the form.
        .ActiveDocument.Bookmarks("QAWO").Select
        .Selection.Text = (CStr(Forms!ReviewDetails!QA_Work_Order))
       
        'Paste the Record.
        .ActiveDocument.Bookmarks("QAWO").Select
        .Selection.Paste
    End With

    'upload to sharepoint.'
   
    ActiveDocument.SaveAs "https://org.eis.afmc.af.mil/sites/309MXW/MXSG/709MXSS/TypeIIA/Quality/PIM" & ActiveDocument.Name, FileFormat:=Word.WdSaveFormat.wdFormatDocumentDefault, AddToRecentFiles:=True

   

    'Quit Microsoft Word and release the object variable.
    objWord.Quit
End Sub
As I can see, you don't used Feddema's example.Test this code (place sub OpenWord to module and add Microsoft Word objects library to references):
Sub tst()
OpenWord "c:\tmp\", "test.docx", "Some text"
End Sub

Public Sub OpenWord(Path As String, DocName As String, Text As String)
Dim objWord As Object
Dim doc As Object
Dim bm As Object
Dim tmplt As String
tmplt = "C:\TMP\NC_Audit_review.dotx"
    'Copy the NC Record on the Review Details form.
    '  DoCmd.GoToControl "QA Work Order"
    '  DoCmd.RunCommand acCmdCopy
    'Start Microsoft Word 2007.
    On Error Resume Next
    Set objWord = GetObject(, "Word.Application")
 
    If Err.Number <> 0 Then
        'Launch a new instance of Word
        Err.Clear
        Set objWord = CreateObject("Word.Application")
    End If
    On Error GoTo 0
        'Make the application visible.
        objWord.Visible = True
        'Create document.
        Set doc = objWord.Documents.Add(tmplt)
        Set bm = doc.Bookmarks("QAWO").Range
        bm.Text = Text
    doc.SaveAs Path & DocName, wdFormatDocumentDefault
    doc.Close wdDoNotSaveChanges
    'Quit Microsoft Word and release the object variable.
    objWord.Quit SaveChanges:=wdDoNotSaveChanges
    Set doc = Nothing
    Set objWord = Nothing
End Sub

Open in new window

I have no Sharepoint and can't test it, but there should be no difference between local and sharepoint path, but may be you should also use local path to sharepoint, like:
"\\servername\309MXW/MXSG/709MXSS/TypeIIA/Quality/PIM"
You can test it. Try manually save document to your Sharepoint
Avatar of yohot

ASKER

Thanks for the example.   How can I then rewrite to point the template stored on my hard drive C:\XXXX\ on my hard drive instead of the default template folder?  

   strDate = CStr(Date)
   'Check whether template is found in the folder
   'Get User Templates path from Word Options dialog
   '(or replace with hard-coded path for your computer)
   Set appWord = GetObject(, "Word.Application")
   strTemplatePath = appWord.Options.DefaultFilePath(wdUserTemplatesPath)
   Debug.Print "Template path: " & strTemplatePath
   strTemplatePath = strTemplatePath & "\Personal Documents\"
   strLetter = "NC_Audit_review.dotx"
   strTemplateNameAndPath = strTemplatePath & strLetter
   Debug.Print "Template and path: " & strTemplateNameAndPath
In my example template is in separate variable:
tmplt = "C:\TMP\NC_Audit_review.dotx"
and it is used here:
Set doc = objWord.Documents.Add(tmplt)
Avatar of yohot

ASKER

Thanks for all the help.  Everything is working as I had hoped except for one minor problem.  

I am still not able to save the newly created Document to my sharepoint site.   I can save it manually but not with the following code:

ActiveDocument.SaveAs "\\org.eis.afmc.af.mil/sites/309MXW/MXSG/709MXSS/TypeIIA/Quality/PIM" & ActiveDocument.Name, FileFormat:=Word.WdSaveFormat.wdFormatDocumentDefault, AddToRecentFiles:=True
Avatar of yohot

ASKER

PS.  here is entire code thus far.  again.  all working except last line.


Private Sub CriticalNC_Click()

Dim objWord As Object
Dim doc As Object
Dim bm As Object
Dim tmplt As String
tmplt = "C:\SPL\NC_Audit_review.dotx"
    'Copy the NC Record on the Review Details form.
    '  DoCmd.GoToControl "QA Work Order"
    '  DoCmd.RunCommand acCmdCopy
    'Start Microsoft Word 2007.
    On Error Resume Next
    Set objWord = GetObject(, "Word.Application")
 
    If Err.Number <> 0 Then
        'Launch a new instance of Word
        Err.Clear
        Set objWord = CreateObject("Word.Application")
       
       
    End If
    On Error GoTo 0
        'Make the application visible.
        objWord.Visible = True
        'Create document.
        Set doc = objWord.Documents.Add(tmplt)
        Set bm = doc.Bookmarks("NC").Range
        bm.Text = Nz(Me.NC)
        Set bm = doc.Bookmarks("RC").Range
        bm.Text = Nz(Me.RC)
        Set bm = doc.Bookmarks("ReviewType").Range
        bm.Text = Nz(Me.Review_Type)
        Set bm = doc.Bookmarks("CalAuth").Range
        bm.Text = Nz(Me.Cal_Authority)
        Set bm = doc.Bookmarks("TODate").Range
        bm.Text = Nz(Me.T_O__Date)
        Set bm = doc.Bookmarks("WLI").Range
        bm.Text = Nz(Me.WLI)
        Set bm = doc.Bookmarks("SelectDate").Range
        bm.Text = Nz(Me.Date_Selected)
        Set bm = doc.Bookmarks("PCOMP").Range
        bm.Text = Nz(Me.PCOMP_Date)
        Set bm = doc.Bookmarks("OWC").Range
        bm.Text = Nz(Me.OWC_RCC)
        Set bm = doc.Bookmarks("CalInt").Range
        bm.Text = Nz(Me.Cal_Int)
        Set bm = doc.Bookmarks("FEMS_ID").Range
        bm.Text = Nz(Me.FEMS_ID_)
        Set bm = doc.Bookmarks("TechWO").Range
        bm.Text = Nz(Me.Tech_Work_Order)
        Set bm = doc.Bookmarks("QAWO").Range
        bm.Text = Nz(Me.QA_Work_Order)
        Set bm = doc.Bookmarks("WUC").Range
        bm.Text = Nz(Me.WUC)
        Set bm = doc.Bookmarks("Noun").Range
        bm.Text = Nz(Me.Noun)
        Set bm = doc.Bookmarks("PN").Range
        bm.Text = Nz(Me.PN)
        Set bm = doc.Bookmarks("SN").Range
        bm.Text = Nz(Me.SN)
        Set bm = doc.Bookmarks("Tech").Range
        bm.Text = Nz(Me.Technician)
        Set bm = doc.Bookmarks("Observation").Range
        bm.Text = Nz(Me.Observation)
        Set bm = doc.Bookmarks("Observation_PIM").Range
        bm.Text = Nz(Me.Observation)
        Set bm = doc.Bookmarks("PR_to_be_performed").Range
        bm.Text = Nz(Me.PR_to_be_performed)
        Set bm = doc.Bookmarks("Results_of_PR").Range
        bm.Text = Nz(Me.Results_of_PR)
       
        'Upload and Save to Sharepoint'
        ActiveDocument.SaveAs "\\org.eis.afmc.af.mil/sites/309MXW/MXSG/709MXSS/TypeIIA/Quality/PIM" & ActiveDocument.Name, FileFormat:=Word.WdSaveFormat.wdFormatDocumentDefault, AddToRecentFiles:=True

       

End Sub