Export Data From Outlook Custom Form to Excel

Sub CommandButton1_Click()
ExportToExcel()
End Sub

Sub ExportToExcel()

Dim appExcel
Dim olMAPI
Dim strTemplatePath
Dim strSheet
Dim Ifld
Dim MItem

Set olMAPI = GetObject("", "Outlook.Application").GetNameSpace("MAPI")
Set Ifld = olMAPI.Folders("Personal Folders").Folders("SamTest")

i=1

'Pick up Template path from the word options dialog
strTemplatePath="H:\"

'Debug.Print "Document folder: " & strTemplatePath

strSheet="SameerTest.xls"
strSheet=strTemplatePath & strSheet

'Set appExcel= New Excel.Application
Set appExcel=GetObject("", "Excel.Application")

appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkBook
Set wks =wkb.Sheets(1)
wks.Activate
wks.Cells(1, 1)="Subject"
wks.Cells(1,2)="ClientName"
wks.Cells(1,3)="ClientAddress"
wks.Cells(1,4)="ClientAge"

appExcel.Application.Visible=TrueFor Each MItem In Ifld.Items

If Left(MItem.Subject, 12) = "Client Form" Then
i = i + 1

If MItem.Subject<>"" Then
wks.Cells(i,1).Value = MItem.Subject
End If

If MItem.UserProperties("010 ClientName").Value<>"" Then
wks.Cells(i,2).Value = MItem.UserProperties("010 ClientName").Value
End If

If MItem.UserProperties("020 ClientFirstName").Value<>"" Then
wks.Cells(i,3).Value = MItem.UserProperties("020 ClientAddress").Value
End If

If MItem.UserProperties("030 ClientInitial").Value<>"" Then
wks.Cells(i,4).Value = MItem.UserProperties("030 ClientAge").Value
End If End If

Next

Set MItem = Nothing
Set Ifld = Nothing
Set strTemplatePath = Nothing
Set strSheet = Nothing
Set olMAPI = Nothing
Set appExcel = Nothing

End Sub