Export Custom Outlook Form Data to MS Access

Dim appAccess
Dim nms
Dim strFolder
Dim fld
Dim strAccessPath
Dim rst
Dim dbe
Dim wks
Dim dbs
Dim itms
Dim itm

Sub CommandButton1_Click()

Set nms = Application.GetNamespace("MAPI")
strFolder = "fbtest folder"
Set fld = nms.Folders("Personal Folders").Folders(strFolder)

'Pick up path to Access database directory from Access SysCmd function
Set appAccess = CreateObject("Access.Application")
strAccessPath = appAccess.SysCmd(9)

'Get DAO version from DBEngine
strDBEngine = appAccess.Application.DBEngine.Version

'MsgBox "DBEngine version: " & strDBEngine

appAccess.Quit

If strDBEngine = "3.51" Then
'Office 97 DAO version
Set dbe = CreateObject("DAO.DBEngine.35")
strDBName = strAccessPath & "fbtestdb.mdb"
ElseIf strDBEngine = "3.6" Then
'Office 2000 DAO version
Set dbe = CreateObject("DAO.DBEngine.36")
strDBName = strAccessPath & "fbtestdb.mdb"

Else

MsgBox "Unknown Office version; canceling"

Exit Sub

End If
'MsgBox "DBName: " & strDBName
Set wks = dbe.Workspaces(0)
Set dbs = wks.OpenDatabase("S:\sameer\fbtestdb.mdb")

'Open Access table containing contact data
Set rst = dbs.OpenRecordset("fbtesttable")
'Set up reference to Outlook folder of items to export

Set itms = fld.Items
ItemCount = itms.Count
If ItemCount = 0 Then
MsgBox "No FB requests to export"

Exit Sub
Else

MsgBox ItemCount & " FB requests to export"

End If
'Set up reference to Outlook folder of items to export
Set itms = fld.Items
ItemCount = itms.Count

If ItemCount = 0 Then

MsgBox "No Fund Builder requests to export"

Exit Sub
Else

MsgBox ItemCount & " FB requests to export"

End If
For Each itm In itms

rst.AddNew

'Custom Outlook properties
rst.Request=itm.userproperties("001 Request")
rst.AccountNumber=itm.userproperties("002 Account Number") rst.ClientName=itm.userproperties("002 Client Name")

rst.Update

Next

rst.Close

MsgBox "All FB requests exported!"

End Sub

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

Counting Commas or Special characters in a cell

Suppose, your names seperated by "," is in cell A4.

Here is the formula to calculate number of commas in the cell A4:

=LEN(A4)-LEN(SUBSTITUTE(A4,",",""))


The first part: LEN(A4) calculates length of string with commas.

The Second part: LEN(SUBSTITUTE(A4,",","")) calculates length of string without commas.

The differnece of the two i.e. first part-second part will give you number of commas in your string.

This formula can come out handy in many calculations.

VB 6.0-Some Formatting Expression

I find it very handy:

Formatting numbers with named formats Expression Result
Format(35988.3708, "general number") 35988.3708
Format(35988.3708, "currency") $35,988.37
Format(-35988.3708, "currency") ($35,988.37)
Format(35988.3708, "fixed") 35988.37
Format(1, "fixed") 1.00
Format(35988.3708, "standard") 35,988.37
Format(1, "standard") 1.00
Format(0.35988, "percent") 35.99%
Format(0, "Yes/No") No
Format(0.35988, "Yes/No") Yes
Format(0, "True/False") False
Format(342, "True/False") True
Format(0, "On/Off") Off
Format(-1, "On/Off") On


Formatting numbers with special characters Expression Result
Format(35988.3708, "00000.0") 35988.4
Format(35988.3708, "0000000.0") 0035988.4
Format(35988.3708, "00,000.00000") 35,988.37080)
Format(6.07, "0.###") 6.07
Format(6.07, "0.000##") 6.070
Format(143879, "#,###,###.00") 143,879.00

Formatting numbers with embedded characters Expression Result
Format(45, "\[00\]") [45]
Format(642, "\£000.00") £642.00
Format(99, "00\¢") 99¢
Format(8, "#0\).") 8).

Formatting dates and time

Format(36715.5784, "general date") 7/8/00 1:52:54 PM
Format(36715.5784, "short date") 7/8/00
Format(36715.5784, "medium date") 08-Jul-00
Format(36715.5784, "long date") Saturday, July 08, 2000
Format(36715.5784, "short time") 13:52
Format(36715.5784, "medium time") 01:52 PM
Format(36715.5784, "long time") 1:52:54 PM
Format(36715.5784, "c") 7/8/00 1:52:54 PM
Format(36715.5784, "d") 8
Format(36715.5784, "dd") 08
Format(36715.5784, "ddd") Sat
Format(36715.5784, "dddd") Saturday
Format(36715.5784, "ddddd") 7/8/00
Format(36715.5784, "dddddd") Saturday, July 08, 2000
Format(36715.5784, "w") 7
Format(36715.5784, "ww") 28
Format(36715.5784, "m") 7
Format(36715.5784, "mm") 07
Format(36715.5784, "mmm") Jul
Format(36715.5784, "mmmm") July
Format(36715.5784, "q") 3
Format(36715.5784, "y") 190
Format(36715.5784, "yy") 00
Format(36715.5784, "yyyy") 2000
Format(36715.5784, "h") 13
Format(36715.5784, "hh") 13
Format(36715.5784, "n") 52
Format(36715.5784, "nn") 52
Format(36715.5784, "s") 54
Format(36715.5784, "ss") 54
Format(36715.5784, "ttttt") 1:52:54 PM
Format(36715.5784, "AM/PM") PM
Format(36715.5784, "am/pm") pm
Format(36715.5784, "A/P") P
Format(36715.5784, "a/p") p
Format(36715.5784, "AMPM") PM

Format "w" returns day of week (1 = Sunday, 7 = Saturday)
Format "ww" returns week of year (1-53)
Format "y" returns day of year (1-366)
Format "h" returns hour of day as one or two digits...if necessary
Format "hh" returns hour of day as two digits...definitely
Above applies to "n"/"nn", and "s"/"ss" as well
Format "AMPM" uses settings from WIN.INI [intl] s1159=AM, s2359=PM
Try mixing and matching the format strings Expression Result
Format(36715.5784, "m-d-yy") 7-8-00
Format(36715.5784, "d-mmmm-y") 8-July-00
Format(36715.5784, "mmmm yyyy") July 2000
Format(36715.5784, "hh:mm a/p") 01:52 p
Format(36715.5784, "m/d/yy h:mm") 7/8/00 13:52

FormatDateTime
This new function works about the same as the regular Format function, but you're only allowed to
use one of 5 constants -
vbGeneralDate, vbLongDate, vbShortDate, vbLongTime, vbShortTime.

MS Excel: Working in multi-sheet environment

When we are referencing one sheet data to another sheet in a formula or otherwise comparing multi sheets in a work book, it becomes tedious to move from sheet to sheet back and forth. Think of a situation where you have to refer data from three or four sheet.

Wouldn't it be nice, if you can have all those three sheets of workbook open side by side?
Did you know that there is an easy way to do this and I always find it very handy while working on a multi-sheet workbook?

Open your workbook, sheet1.

Go to Window tab,
Click on New Window,
Select sheet 2 on this newly opened workbook where you will see on the top with the name: 2.




Again repeat the same steps and open sheet 3. Here with the name, you will see: 3.

Now, that you have the same workbook opened thrice with different sheets,

Go to window,
Click arrange,
Select Vertical

and here you go, three sheet of same workbook opened side by side, toggle around and enjoy working on multi-sheet workbook.