Referencing a custom Outlook form

[gwoman]

Hi all ...

I have a Calendar in Outlook for specific Kaizen Events. Each new appointment ... when created brings up the custom form I created. The first page is all the original appointment information and the second page is where my custom stuff resides. I wrote some code to extract the data from each event and put it into an excel spreadsheet. It works fine for all the information on the first page ... however I can’t seem to get it to pull the data from the second page(my custom form).
Is there a specific way to reference the custom form? I have followed the same process as on the first page ... referencing the controls ... but no data gets extracted!

Any help would be greatly appreciated.

Thanks
gwoman

 

[SkipVought]

Hi,

I wrote some code to extract the data from each event and put it into an excel spreadsheet. It works fine for all the information on the first page

Please post the code that works AND the code that does not work.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[gwoman]

Here is the code that gets the data from the first page ...

CreateWorksheet:
Set appExcel = GetObject(, "Excel.Application")
appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate
appExcel.Application.Visible = True

'Adjust i (row number) to be 1 less than the number of the first body row
i = 3

'Iterate through contact items in Calendar folder, and export a few fields
'from each item to a row in the Calendar worksheet
For Each itm In ritms
If itm.Class = olAppointment Then
'Process item only if it is an appointment item
i = i + 1

'j is the column number
j = 1

Set rng = wks.Cells(i, j)
If itm.Start <> "" Then rng.Value = itm.Start
j = j + 1

Set rng = wks.Cells(i, j)
If itm.End <> "" Then rng.Value = itm.End
j = j + 1

Set rng = wks.Cells(i, j)
If itm.CreationTime <> "" Then rng.Value = itm.CreationTime
j = j + 1

Set rng = wks.Cells(i, j)
If itm.Subject <> "" Then rng.Value = itm.Subject
j = j + 1

Set rng = wks.Cells(i, j)
If itm.Location <> "" Then rng.Value = itm.Location
j = j + 1

Set rng = wks.Cells(i, j)
If itm.Categories <> "" Then rng.Value = itm.Categories
j = j + 1

Set rng = wks.Cells(i, j)
If itm.IsRecurring <> "" Then rng.Value = itm.IsRecurring
j = j + 1

Set rng = wks.Cells(i, j)
On Error Resume Next

j = j + 1
End If
i = i + 1
Next itm





And here is the code I'm using to try and pull the data from the custom form ....

For Each itm In ritms
If itm.Class = olAppointment Then
'Process item only if it is an Kaizen Event Details item
i = i + 1

'j is the column number
j = 1

Set rng = wks.Cells(i, j)
'If itm.Start <> "" Then rng.Value = itm.Start
If itm.UserProperties("txtCoFacilitatorName") <> "" Then
rng.Value = itm.UserProperties("txtCoFacilitatorName")
j = j + 1
End If

Set rng = wks.Cells(i, j)
'If itm.End <> "" Then rng.Value = itm.End
If itm.UserProperties("txtCostAvoidance") <> "" Then
rng.Value = itm.UserProperties("txtCostAvoidance")
j = j + 1
End If

Set rng = wks.Cells(i, j)
'If itm.CreationTime <> "" Then rng.Value = itm.CreationTime
If itm.UserProperties("txtCostReduction") <> "" Then
rng.Value = itm.UserProperties("txtCostReduction")
j = j + 1
End If

Set rng = wks.Cells(i, j)
'If itm.Subject <> "" Then rng.Value = itm.Subject
If itm.UserProperties("txtEventShortDescription") <> "" Then
rng.Value = itm.UserProperties("txtEventShortDescription")
j = j + 1
End If

Set rng = wks.Cells(i, j)
'If itm.Location <> "" Then rng.Value = itm.Location
If itm.UserProperties("txtFreeText") <> "" Then
rng.Value = itm.UserProperties("txtFreeText")
j = j + 1
End If

Set rng = wks.Cells(i, j)
'If itm.Categories <> "" Then rng.Value = itm.Categories
If itm.UserProperties("txtHyperlinkEventFolder") <> "" Then
rng.Value = itm.UserProperties("txtHyperlinkEventFolder")
j = j + 1
End If

Set rng = wks.Cells(i, j)
'If itm.IsRecurring <> "" Then rng.Value = itm.IsRecurring
If itm.UserProperties("txtHyperlinkScopingDoc") <> "" Then
rng.Value = itm.UserProperties("txtHyperlinkScopingDoc")
j = j + 1
End If

Set rng = wks.Cells(i, j)
'If itm.IsRecurring <> "" Then rng.Value = itm.IsRecurring
If itm.UserProperties("txtImprovementArea") <> "" Then
rng.Value = itm.UserProperties("txtImprovementArea")
j = j + 1
End If

Set rng = wks.Cells(i, j)
'If itm.IsRecurring <> "" Then rng.Value = itm.IsRecurring
If itm.UserProperties("txtKaizenFacilitator") <> "" Then
rng.Value = itm.UserProperties("txtKaizenFacilitator")
j = j + 1
End If

Set rng = wks.Cells(i, j)
'If itm.IsRecurring <> "" Then rng.Value = itm.IsRecurring
If itm.UserProperties("txtKaizenStatus") <> "" Then
rng.Value = itm.UserProperties("txtKaizenStatus")
j = j + 1
End If

Set rng = wks.Cells(i, j)
'If itm.IsRecurring <> "" Then rng.Value = itm.IsRecurring
If itm.UserProperties("txtLDTPresent") <> "" Then
rng.Value = itm.UserProperties("txtLDTPresent")
j = j + 1
End If

Set rng = wks.Cells(i, j)
'If itm.IsRecurring <> "" Then rng.Value = itm.IsRecurring
If itm.UserProperties("txtProcessTeam") <> "" Then
rng.Value = itm.UserProperties("txtProcessTeam")
j = j + 1
End If


Set rng = wks.Cells(i, j)
'If itm.IsRecurring <> "" Then rng.Value = itm.IsRecurring
If itm.UserProperties("txtQuarterOccuring") <> "" Then
rng.Value = itm.UserProperties("txtQuarterOccuring")
j = j + 1
End If

Set rng = wks.Cells(i, j)
'If itm.IsRecurring <> "" Then rng.Value = itm.IsRecurring
If itm.UserProperties("chkBoxReminder") <> "" Then
rng.Value = itm.UserProperties("chkBoxReminder")
j = j + 1
End If

Set rng = wks.Cells(i, j)
On Error Resume Next
j = j + 1
End If
i = i + 1
Next itm



Thanks

 

[SkipVought]

add these declarations at the top of your module BEFORE any procedures.

Dim appExcel As Object
Dim wkb As Object
Dim wks As Object

If you run the stuff that assigns the Excel application object and the workbook and worksheet objects before the second bit of code, you may be OK.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[gwoman]

Here is a list of all my declarations at the top of my module ...

Dim appExcel As Excel.Application
Dim appWord As Word.Application
Dim blnMultiDay As Boolean
Dim dteEnd As Date
Dim dteStart As Date
Dim fld As Outlook.MAPIFolder
Dim i As Integer
Dim intReturn As Integer
Dim itms As Outlook.Items
Dim j As Integer
Dim lngCount As Long
Dim nms As Outlook.NameSpace
Dim ritms As Outlook.Items
Dim rng As Excel.range
Dim strDateRange As String
Dim strEndDate As String
Dim strSheet As String
Dim strSheetTitle As String
Dim strStartDate As String
Dim strTemplatePath As String
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet


Thanks ...
g

 

[SkipVought]

http://support.microsoft.com/kb/266428/#top

http://support.microsoft.com/kb/146636/EN-US/

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}