We're still not getting it. Here's a copy of our thread and we hope
someone will be able to help us with this task: Generate a macro that
gives us a birthday report from BCM
~~~~~~~~~~
In Business Contact Manager, Is there a way to produce a report for
birthdays?
1. Start Outlook
2. Click Tools->Macro->Visual Basic Editor
3. If not already expanded, expand Modules and click on Module1
4. Copy the code below and paste it into the right-hand pane of the
editor window
5. Edit the code as necessary. I included a comment line wherever
something needs to be edited
6. Click the diskette icon on the toolbar to save the changes
7. Close the VB Editor
8. Click Tools->Macro->Security
9. Set the Security Level to Medium. The macro cannot run if the
Security Level is High
Sub ListBirthdays()
Dim strMonths As String, _
arrMonths As Variant, _
intCount As Integer, _
olkContacts As Outlook.MAPIFolder, _
olkContact As Outlook.ContactItem, _
olkMatches As Outlook.Items, _
objFSO As Object, _
objFile As Object
strMonths = InputBox("Enter the months (comma separated) you want
to list birthdays for.", "Birthday List")
If strMonths <> "" Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Change the path and filename below as needed
Set objFile =
objFSO.CreateTextFile("C:\eeTesting\BirthdayList.txt")
arrMonths = Split(strMonths, ",")
Set olkContacts = OpenMAPIFolder("\Saved Mail\Inbox")
For intCount = LBound(arrMonths) To UBound(arrMonths)
objFile.WriteLine "Birthdays in " &
MonthName(arrMonths(intCount))
Set olkMatches = olkContacts.Items.Restrict("[Birthday] <>
''")
For Each olkContact In olkMatches
If Month(olkContact.Birthday) =
Int(arrMonths(intCount)) Then
objFile.WriteLine vbTab & olkContact.FullName & "
" & olkContact.Birthday
End If
Next
Next
objFile.Close
End If
Set objFile = Nothing
Set objFSO = Nothing
Set olkMatches = Nothing
Set olkContact = Nothing
Set olkContacts = Nothing
MsgBox "All done!"
End Sub
'Credit where credit is due.
'The code below is not mine (well, a little of it is). I found it
somewhere on the
'internet but do not remember where or who the author is. The
original author(s)
'deserves all the credit for these functions.
Function OpenMAPIFolder(ByVal szPath As String)
Dim app, ns, flr As MAPIFolder, szDir, i
On Error GoTo errOMF
Set flr = Nothing
Set app = CreateObject("Outlook.Application")
If Left(szPath, Len("\")) = "\" Then
szPath = Mid(szPath, Len("\") + 1)
Else
Set flr = app.ActiveExplorer.CurrentFolder
End If
While szPath <> ""
i = InStr(szPath, "\")
If i Then
szDir = Left(szPath, i - 1)
szPath = Mid(szPath, i + Len("\"))
Else
szDir = szPath
szPath = ""
End If
If IsNothing(flr) Then
Set ns = app.GetNamespace("MAPI")
Set flr = ns.Folders(szDir)
Else
Set flr = flr.Folders(szDir)
End If
Wend
Set OpenMAPIFolder = flr
On Error GoTo 0
Exit Function
errOMF:
Set OpenMAPIFolder = Nothing
On Error GoTo 0
End Function
Function IsNothing(Obj)
If TypeName(Obj) = "Nothing" Then
IsNothing = True
Else
IsNothing = False
End If
End Function
~~~~~~~~~~~~~~~~~~~~~~~~~~~
We need to make a change. Before we do that though I need to find out
what the path is to where BCM stores its contacts. To do that we'll
use another macro.
Sub ShowFolderPath()
MsgBox "The path to the selected folder is " & vbCrLf & _
Application.ActiveExplorer.CurrentFolder.FolderPath,
vbInformation + vbOKOnly, "Show Folder Path"
End Sub
Folloing the instructions I posted above, copy this code and paste it
into Outlook. Next, click on the folder that houses the BCM contacts
and then run the macro. It'll pop up a dialog-box giving the path to
that folder. Post that path here and I'll fix the code.
~~~~~~~~~~~~~~~`
Seems to bomb right here:
Set olkMatches = olkContacts.Items.Restrict("[Birthday] <> ''")
with an error:
Run Time error '91':
Object variable or With block variable not set
~~~~~~~~~~~~~~
The error means that one of the objects isn't set (i.e. is not an
object). In this case it'd have to be olkContacts. Are you sure the
path for that folder is correct? It seems strange to be looking in a
folder called Inbox for contact information.
