OFFICE VBA - Take macro variables from Outlook macro to populate a word document

There are several ways of adding data to a Word document.
 
The easiest is to use Form Fields on a forms-protected document

Sub FillFormFields()
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    
    Set wrdApp = CreateObject("Word.Application")
    Set wrdDoc = wrdApp.Documents.Add("C:\MyTemplates\MyTEmplate.doc")
    wrdDoc.FormFields("Text1").Result = strName
    wrdDoc.FormFields("Text2").Result = strAddress
    '...
    wrdDoc.saveas "C:\MyFolder\MyDoc.doc"
    wrdDoc.Close wdDoNotSaveChanges
    wrdApp.Quit
End Sub

Select allOpen in new window

Ok.. Not sure why it isnt working.. I go through the outlook macro.. answer all the questions.. it creates the calendar item fine.. when it gets to the word part it opens up a box that is not visible on the task bar unless i do a ALT-TAB to show Files in Use.. I put screen shots of task bar and the Alt-Tab.. if I use ALT-TAB to go to the word one.. I get a file in use error on some template.. if I select copy a new file then it opens up word but none of the fields are populated.

Thanks.
INUSE.jpg
TASKBAR.JPG
FIU-ERROR.JPG

The code that I gave you is to create a new document, fill the fields and then save and close it. It does open the template, or show the application.

You do seem to be using Office 2007, but the principle is still the same. This new macro makes the application visible, so that if it aborts, you will not be left with an invisible application that needs task manager to delete.

Sub FillFormFields()
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = true
    Set wrdDoc = wrdApp.Documents.Add("C:\MyTemplates\AVWiz12s.dotm")
    wrdDoc.FormFields("Text1").Result = strName
    wrdDoc.FormFields("Text2").Result = strAddress
    '...
    wrdDoc.saveas "C:\MyFolder\MyDoc.doc"
    wrdDoc.Close wdDoNotSaveChanges
    wrdApp.Quit
End Sub

Select allOpen in new window

Ok.. so if I want it to open a document that is already formated and just add the fields?  I just want it to open.. fill in the boxes.. the user prints it and closes it.. there is no need to save it.

Thanks for your help!

You need to design a template with the form fields, and the protect it for forms. Then you create a new document from it using the documents.add method.

You can plug the data in by setting the fields' result properties to the new text.

If you want to print it, you can use :

    wrdDoc.PrintOut

Not sure what is wrong but it keeps telling me it is locked for editing.  Where is it pulling that AVWiz12s name from?

Sub FillFormFields()
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Add("C:\temp\AVWiz12s.dotm")
    wrdDoc.FormFields("strName").Result = strName
    wrdDoc.FormFields("strAddress").Result = strAddress
    wrdDoc.FormFields("strCity").Result = strCity
    wrdDoc.FormFields("strPhone").Result = strPhone
    wrdDoc.FormFields("strMakeModel").Result = strMakeModel
    wrdDoc.FormFields("strWarranty").Result = strWarranty
    wrdDoc.FormFields("strAltPhone").Result = strAltPhone
    wrdDoc.FormFields("strCBA").Result = strCBA
    'wrdDoc.FormFields("strIssue").Result = strIssue
    wrdDoc.FormFields("strDTE").Result = strDTE
    wrdDoc.FormFields("strTM").Result = strTM
    '...
    'wrdDoc.SaveAs "C:\MyFolder\MyDoc.doc"
    'wrdDoc.Close wdDoNotSaveChanges
    'wrdApp.Quit
End Sub

Select allOpen in new window

Besides there.. I was calling it RRA-TEMPLATE and it would still say AVWiz12s.dotm is locked.

I didn't recognise the name, but it seems to be a template provided by MS that features in several Word/Outlook problems. I'll see what else I can find out.

It seems to be the dll for the Avery Labels Wizard. I don't have in on my Win2000/ Office 2003 or my WinXP/Office 2007 system.

Do you have an Avery Add-in?

I do.. I will remove it.. not like I have used it much.

Ok that error is gone.. so on the word document.. I put in a text form field.. when word opens it is not populating.. is that the right form field to use?

Yes. It has to be a text input form field. The only other two types of form field are checkbox and dropdown.

In Word 2007, form fields are inserted via the 'Legacy tools' button in the controls section of the Developer tab on the Ribbon.

Make sure that the template is protected for 'Filling in forms' after designing.

I have set the word document like you stated.. I am trying just 1 field.. Text1.. the form is locked except for form filling.. when it opens up the field is not populated.  I have attached all current code.

I have attached screen shots as well.

I really do appreciate all of your help.

Function IsNothing(obj)
  If TypeName(obj) = "Nothing" Then
    IsNothing = True
  Else
    IsNothing = False
  End If
End Function
 
Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        olkFolder As Outlook.MAPIFolder
    On Error GoTo ehOpenOutlookFolder
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        If Left(strFolderPath, 1) = "\" Then
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        End If
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            If IsNothing(olkFolder) Then
                Set olkFolder = Session.Folders(varFolder)
            Else
                Set olkFolder = olkFolder.Folders(varFolder)
            End If
        Next
        Set OpenOutlookFolder = olkFolder
    End If
    On Error GoTo 0
    Exit Function
ehOpenOutlookFolder:
    Set OpenOutlookFolder = Nothing
    On Error GoTo 0
End Function
 
 
Sub RRAAppointment()
    Const MACRONAME = "RRA Appointment"
    Dim strName As String, strAddress As String, strCity As String, strState As String, strZip As String, strCAT As String, _
        strPhone As String, strAltPhone As String, strCBA As String, strMakeModel As String, strLoc As String, strPT1 As String, _
        strWarranty As String, strIssue As String, strPT As String, strDTE As Date, strTM As String, strDIR As String, olkAppt As Outlook.AppointmentItem
    
    strDTE = InputBox("Enter a date #/##", MACRONAME)
    strTM = InputBox("Enter a time slot : (1) 8-11, (2) 9-12, (3) 10-1, (4) 11-2, (5) 3-6, (6) 4-7", MACRONAME)
    strName = InputBox("Customer Name", MACRONAME)
    strAddress = InputBox("Address", MACRONAME)
    strDIR = InputBox("Directions", MACRONAME)
    strPT = InputBox("City/Location : (1) E. STG, (2) W. STG, (3) S. STG, (4) BLOOM, (5) BLOOM HILLS, (6) SUN RIVER, (7) IVINS, (8) SANTA CLARA, (9) WASHINGTON, (10) HURRICANE, (11) CORAL CANYON, (12) MESQUITE, (13) CEDAR, OR SPECIFIY CITY", MACRONAME)
    strPhone = InputBox("Phone", MACRONAME)
    strAltPhone = InputBox("Alterante phone", MACRONAME)
    strCBA = InputBox("Call Before Arrival minutes", MACRONAME)
    strMakeModel = InputBox("Enter a make/model", MACRONAME)
    strWarranty = InputBox("(C)ash (W)arranty or (P)arts Warranty", MACRONAME)
    strIssue = InputBox("Issue", MACRONAME)
    
    
If strPT = "1" Then
strCity = "St George"
strPT1 = "E. St George - Washington"
strCAT = strPT1
ElseIf strPT = "2" Then
strCity = "St George"
strPT1 = "W. St George - Santa Clara - Ivins"
strCAT = strPT1
ElseIf strPT = "3" Then
strCity = "St George"
strPT1 = "S. St George - Bloomington/Bloomington Hills - Sun River"
strCAT = strPT1
ElseIf strPT = "4" Then
strCity = "Bloomington"
strPT1 = "S. St George - Bloomington/Bloomington Hills - Sun River"
strCAT = strPT1
ElseIf strPT = "5" Then
strCity = "Bloomington Hills"
strPT1 = "S. St George - Bloomington/Bloomington Hills - Sun River"
strCAT = strPT1
ElseIf strPT = "6" Then
strCity = "Sun River"
strPT1 = "S. St George - Bloomington/Bloomington Hills - Sun River"
strCAT = strPT1
ElseIf strPT = "7" Then
strCity = "Ivins"
strPT1 = "W. St George - Santa Clara - Ivins"
strCAT = strPT1
ElseIf strPT = "8" Then
strCity = "Santa Clara"
strPT1 = "W. St George - Santa Clara - Ivins"
strCAT = strPT1
ElseIf strPT = "9" Then
strCity = "Washington"
strPT1 = "E. St George - Washington"
strCAT = strPT1
ElseIf strPT = "10" Then
strCity = "Hurricane"
strPT1 = "Hurricane"
strCAT = strPT1
ElseIf strPT = "11" Then
strCity = "Coral Canyon"
strPT1 = "Hurricane"
strCAT = strPT1
ElseIf strPT = "12" Then
strCity = "Mesquite"
strPT1 = "Mesquite"
strCAT = strPT1
ElseIf strPT = "13" Then
strCity = "Cedar"
strPT1 = "Cedar"
strCAT = strPT1
Else
strCity = strPT
strPT1 = ""
End If
 
If strTM = "1" Then
strTM = "08:00:00"
strLoc = "8-11 - " & strPT1
ElseIf strTM = "2" Then
strTM = "09:00:00"
strLoc = "9-12 - " & strPT1
ElseIf strTM = "3" Then
strTM = "10:00:00"
strLoc = "10-1 - " & strPT1
ElseIf strTM = "4" Then
strTM = "11:00:00"
strLoc = "11-2 - " & strPT1
ElseIf strTM = "5" Then
strTM = "15:00:00"
strLoc = "3-6 - " & strPT1
ElseIf strTM = "6" Then
strTM = "16:00:00"
strLoc = "4-7 - " & strPT1
End If
 
If strWarranty = "c" Then
strWarranty = "CA$H"
ElseIf strWarranty = "w" Then
strWarranty = "WARRANTY"
ElseIf strWarranty = "p" Then
strWarranty = "PARTS WARRANTY"
End If
 
 
    Set olkAppt = Application.CreateItem(olAppointmentItem)
    With olkAppt
        .Subject = strName & " - " & strAddress & " - " & strCity & " - " & strPhone _
            & " - " & strAltPhone & " - " & strMakeModel & " - " & strWarranty & " - " & strIssue & " - " _
            & "CBA : " & strCBA
        .Start = strDTE & " " & TimeValue(strTM)
        .Duration = 180
        .Location = strLoc
        .Body = "Appointment set : " & Now & " -- " & Environ("USERNAME") & " -- Directions : " & strDIR
        .Categories = strPT1
        .Display
    End With
    
    Set olkSharedFolder = OpenOutlookFolder("Mailbox - Dennis Rindlisbach\Calendar")
    olkAppt.Move olkSharedFolder
    
    FillFormFields
    
    Set olkAppt = Nothing
End Sub
 
Sub FillFormFields()
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Add("R:\forms\RRA-WO-TEMPLATE.dotm")
    wrdDoc.FormFields("Text1").Result = strName
    'wrdDoc.FormFields("strAddress").Result = strAddress
    'wrdDoc.FormFields("strCity").Result = strCity
    'wrdDoc.FormFields("strPhone").Result = strPhone
    'wrdDoc.FormFields("strMakeModel").Result = strMakeModel
    'wrdDoc.FormFields("strWarranty").Result = strWarranty
    'wrdDoc.FormFields("strAltPhone").Result = strAltPhone
    'wrdDoc.FormFields("strCBA").Result = strCBA
    'wrdDoc.FormFields("strIssue").Result = strIssue
    'wrdDoc.FormFields("strDTE").Result = strDTE
    'wrdDoc.FormFields("strTM").Result = strTM
    '...
    'wrdDoc.SaveAs "C:\MyFolder\MyDoc.doc"
    'wrdDoc.Close wdDoNotSaveChanges
    'wrdApp.Quit
End Sub

Select allOpen in new window

Opps.
wordblank.JPG
dotm.JPG

We are getting closer.. the strName fills in but the others are blank.. here is what I changed in the code.

End With
    
    Set olkSharedFolder = OpenOutlookFolder("Mailbox - Dennis Rindlisbach\Calendar")
    olkAppt.Move olkSharedFolder
    
    FillFormFields strName, strCity, strAddress, strPhone, strMakeModel, strWarranty, strAltPhone, strCBA, strIssue, strDT, strTM
    
    Set olkAppt = Nothing
End Sub
 
Sub FillFormFields(strName As String, strCity As String, strAddress As String, strPhone As String, strMakeModel As String, strWarranty As String, strAltPhone As String, strCBA As String, strIssue As String, strDT As String, strTM As String)
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document

Select allOpen in new window

I trust that you have uncommented the lines for other fields.

If so, I suggest that you put a breakpoint (F9) on one of the early lines in the FillFormFields procedure. Then you can step through each line (F8) in the procedure, and check the values of the passed variables as each line is executed.

No I was an idiot and left them all commented out.. it is working.. one last question..

On  wrdDoc.PrintOut can I specify a printer other than Default?

You have been awesome through all of this, I appreciate it.

Thank you for your excellent help.  It will make our job so much easier.  You help has been top notch!  Thanks again.

Just wanted to add I figured out the select the printer issue.  I am posting the code so if someone else is looking for it they can find it.

You can figure out the names of your printers by running this from a word macro..

http://support.microsoft.com/kb/162239

Just to make sure Word didnt set our default printer as Brother-WO I told it to set the active printer back to the Okidata before closing.  Seems to be working well.

 wrdApp.ActivePrinter = "Brother-WO on Ne02:"
    wrdDoc.PrintOut
    wrdApp.ActivePrinter = "OKI C5500 on Ne00:"
    wrdDoc.Close wdDoNotSaveChanges
    wrdApp.Quit

Select allOpen in new window