Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 714
  • Last Modified:

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

Ok.. so my ever growing macro .. I want to see if I can add more functions.  

You run the macro.. answer questions and it creates a calendar item.  Now I would like to somehow pass those variables to a work order designed in Word and populate the fields like name, address, etc.

Any help is greatly appreciated.
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
 
    
    Set olkAppt = Nothing
End Sub

Open in new window

0
DMTechGrooup
Asked:
DMTechGrooup
  • 12
  • 8
1 Solution
 
GrahamSkanRetiredCommented:
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

Open in new window

0
 
DMTechGrooupAuthor Commented:
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
0
 
GrahamSkanRetiredCommented:
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

Open in new window

0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
DMTechGrooupAuthor Commented:
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!
0
 
GrahamSkanRetiredCommented:
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

0
 
DMTechGrooupAuthor Commented:
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

Open in new window

0
 
DMTechGrooupAuthor Commented:
Besides there.. I was calling it RRA-TEMPLATE and it would still say AVWiz12s.dotm is locked.
0
 
GrahamSkanRetiredCommented:
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.
0
 
GrahamSkanRetiredCommented:
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?
0
 
DMTechGrooupAuthor Commented:
I do.. I will remove it.. not like I have used it much.
0
 
DMTechGrooupAuthor Commented:
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?
0
 
GrahamSkanRetiredCommented:
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.
0
 
DMTechGrooupAuthor Commented:
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

Open in new window

0
 
DMTechGrooupAuthor Commented:
0
 
GrahamSkanRetiredCommented:
The variable strName is out of scope.

I strongly recommend that you use Option Explicit in your code modules. There is an option to do that automatically for all new modules in the application. In the VBA editor, open the Options dialogue in the Tools menu and choose the Edit tab. Tick the 'Require variable declaration' checkbox. (While you're there , you may want to remove the tick from the  'Auto Syntax check', so that you don't get an annoying message whenever you try to leave an unfinished code line.)

For existing modules you will have manually to add the Option Explicit line in the declarations section.

With this line in place, you will get a 'Variable not defined' error on any variables that are not known to the procedure.

You can declare all the relevant  variables with a wider scope at module or project level. In complex programs this can get hard to manage because the programmer can lose track of all the places that the variable can get modified, so the recommended way is to pass the variables in the call.



'...    
    FillFormFields strName
    
    Set olkAppt = Nothing
End Sub
 
Sub FillFormFields(strName As String)
'...

Open in new window

0
 
DMTechGrooupAuthor Commented:
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

Open in new window

0
 
GrahamSkanRetiredCommented:
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.
0
 
DMTechGrooupAuthor Commented:
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.
0
 
DMTechGrooupAuthor Commented:
Thank you for your excellent help.  It will make our job so much easier.  You help has been top notch!  Thanks again.
0
 
DMTechGrooupAuthor Commented:
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

Open in new window

0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 12
  • 8
Tackle projects and never again get stuck behind a technical roadblock.
Join Now