Faxing via outlook 2003

Posted on 2009-12-18
Medium Priority
Last Modified: 2012-05-08
Hi Experts,

I have set up an e-mail account 'fax@mydomain.com' where I want users to be able to send an e-mail to it and then it will get faxed to the number specified in the subject line

What I have - Server 2003, Outlook 2003, Visual Studio 2008, a HP OfficeJet 7200 All in One that is wired to the network.
The Printer and Fax driver are installed on the server.

I can code for VBA (did alot in Excel, but never for outlook), and VB.NET.

I do not have exchange - and the company won't spring for it, nor for other third party software, so it's gotta be an in-house solution.

Any suggestions on where to get started or examples?
Question by:sgaggerj
  • 2
LVL 28

Accepted Solution

peakpeak earned 1500 total points
ID: 26088049
Script code examples to build from here:
http://www.outlookcode.com (download Sues code examples)

Author Comment

ID: 26112440
Thanks!  I didn't find Sue's code examples, but I'll keep looking.  I'll give you points because I will be using some of those examples in future projects.

In the meantime I came up with a solution and the code is below.  I can't take 100% of the credit for the code below, alot of it I wrote or re-wrote myself, the rest I found on Google and thanks to those that wrote and posted it.

For this to work as written, the subject of the e-mail needs to be in the form


Now you can send an e-mail to the address you want and it will be faxed.

This was written for the HP Fax application, but can be easily modified to use any other fax app.
'Outlook configuration to auto-fax incoming e-mails.

' Open outlook and open the VBA IDE (Alt + F11)
' Under THISOUTLOOKSESSION paste the following code:

Public Sub FaxMe(item As Outlook.MailItem)

' change the active printer to the fax
Dim result As Double
result = Shell("c:\printing\changeprinter.exe fax", vbNormalFocus)

' Pause and make sure the app has changed the printer
Call Pause(5)

' print to start the fax dialog
' need to determine max time to open the fax dialog
Call Pause(20)

' start the fax helper to fill in the fields and fax
result = Shell("c:\printing\faxhelper.exe " & item.Subject, vbNormalFocus)

Call Pause(10)

' change active printer back to the standard printer
result = Shell("c:\printing\changeprinter.exe", vbNormalFocus)

End Sub

Private Sub Pause(p As Integer)
    Dim WAIT As Double
    WAIT = Timer
    While Timer < WAIT + p
End Sub

' In Outlook, create a rule that checks the account you want, and set it to run a script.
' Select the Project1.ThisOutlookSession.FaxMe script
' modify any other rules you want.

' Now for the VB.Net code for 'CHANGEPRINTER.EXE' and 'FAXHELPER.EXE'


Imports System.Windows.Forms
Imports System.Text

Module Module1

    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
    Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hwndParent As IntPtr, ByVal hwndChildAfter As IntPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As IntPtr
    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As IntPtr) As Integer
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As IntPtr, ByVal lpString As StringBuilder, ByVal cch As Integer) As Integer
    Private Declare Function ShowWindow Lib "user32" (ByVal handle As IntPtr, ByVal nCmd As Int32) As Boolean
    Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As IntPtr
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

    Dim ipMain As IntPtr
    Dim bExit As Boolean = False
    Dim bSub As Boolean = False

    Dim bFName, bLName, bCompany, bFax As Boolean
    Dim ipFName, ipLName, ipCompany, ipFax, ipSend As IntPtr

    Private Const HP_FAX_APP_TITLE As String = "HP Officejet 7200 series - Send Fax"
    Private Const FIRST_NAME_LABEL As String = "First Name"
    Private Const LAST_NAME_LABEL As String = "Last Name"
    Private Const FAX_NUMBER_LABEL As String = "Fax Number"
    Private Const COMPANY_LABEL As String = "Company"
    Private Const SEND_FAX_LABEL As String = "Send Fax"

    Private Const WM_SETTEXT As Integer = &HC
    Private Const SW_RESTORE As Integer = 9
    Private Const BM_SETSTATE As Integer = &HF3
    Private Const BM_CLICK As Integer = &HF5

    ' arguments to this are passed from Outlook via command line
    ' in the form 
    ' Fax number does not contain any characters other than numerics.
    Sub Main()
        ipMain = FindWindow(vbNullString, HP_FAX_APP_TITLE)
        If CLng(ipMain) = 0 Then
            MessageBox.Show("Could not locate Fax Manager", "Exit")
            Exit Sub
        End If

        bExit = False
        bSub = True

        RecurseWindows(CLng(ipMain), )
        ShowWindow(ipMain, SW_RESTORE)


    End Sub

    Private Sub SendFax()
        ' send a click to the SEND FAX button
        SendMessage(ipSend, BM_CLICK, 0, 0)

    End Sub

    Private Sub FillFields()
        ' concatenate all the args into one string as
        ' passing the values with spaces separates them into multiple arguments
        Dim args As String = ""
        For Each s As String In My.Application.CommandLineArgs
            args += s + " "

        ' split the fields on the ;
        Dim fields() As String = Split(Trim(args), ";")

        ' fill in the NAME, COMPANY and FAX NUMBER fields
        SendMessageByString(ipFName, WM_SETTEXT, CInt(IntPtr.Zero), fields(0))
        SendMessageByString(ipCompany, WM_SETTEXT, CInt(IntPtr.Zero), fields(1))
        SendMessageByString(ipFax, WM_SETTEXT, CInt(IntPtr.Zero), fields(2))

    End Sub
    Public Sub RecurseWindows(Optional ByVal Parent_hWnd As Long = 0, Optional ByVal Level As Long = 0)
        'take a look at each control in the list
        ' if it's text is one of the items i'm looking for
        ' need to get the next control and that should be the
        ' handle i need

        If CBool(Parent_hWnd) Then
            ' if the handle is not 0 (false)

            ' get the window text of the current window (control)
            Dim tLen As Long, sbWindowText As New System.Text.StringBuilder
            sbWindowText.Append(Space(260)) 'MAX_PATH
            tLen = GetWindowTextLength(CType(Parent_hWnd, IntPtr))
            GetWindowText(CType(Parent_hWnd, IntPtr), sbWindowText, sbWindowText.Length)

            If bSub Then
                ' assign an intptr because it's the control we're looking for
                AssignIntPtr(CType(Parent_hWnd, IntPtr), sbWindowText.ToString)
            End If
            Dim Child_hWnd As Long
            Child_hWnd = CLng(FindWindowEx(CType(Parent_hWnd, IntPtr), CType(0, IntPtr), vbNullString, vbNullString))

            Do While CBool(Child_hWnd)

                RecurseWindows(Child_hWnd, Level + 1)
                Child_hWnd = CLng(FindWindowEx(CType(Parent_hWnd, IntPtr), CType(Child_hWnd, IntPtr), vbNullString, vbNullString))

        End If
    End Sub
    Private Sub AssignIntPtr(ByVal Parent_hWnd As IntPtr, ByVal Text As String)
        'the text we are actually looking for here is the label that precedes the text/combobox we want to change, so
        'set a flag and next time through the loop assign the intptr

        If bFName Then
            ipFName = Parent_hWnd
            bFName = False
        ElseIf bLName Then
            ipLName = Parent_hWnd
            bLName = False
        ElseIf bCompany Then
            ipCompany = Parent_hWnd
            bCompany = False
        ElseIf bFax Then
            ipFax = Parent_hWnd
            bFax = False
        End If

        Select Case Replace(Text.ToString, "&", "")
            Case FIRST_NAME_LABEL
                bFName = True
            Case LAST_NAME_LABEL
                bLName = True
            Case COMPANY_LABEL
                bCompany = True
            Case FAX_NUMBER_LABEL
                bFax = True
            Case SEND_FAX_LABEL
                ' the only special case the control is current parent, not the next control
                ipSend = Parent_hWnd
            Case Else

        End Select
    End Sub
End Module


Imports System.Management

Module Module1
    ' part of the default printer name (change this as needed)
    Private Const DEFAULT_PRINTER As String = "Samsung"

    Sub Main()
        Dim search As System.Management.ManagementObjectSearcher
        Dim results As System.Management.ManagementObjectCollection
        Dim printer As System.Management.ManagementObject
        Dim args(1) As Object

        Dim type As String = ""

            type = My.Application.CommandLineArgs(0)
        Catch ex As Exception
            ' in case arguments are not specified - default to the default printer
            type = DEFAULT_PRINTER
        End Try

        search = New System.Management.ManagementObjectSearcher("select * from win32_printer")
        results = search.Get()

        For Each printer In results
            If printer("Name").ToString.Contains(type) Then
                printer.InvokeMethod("SetDefaultPrinter", args(0))
            End If
    End Sub

End Module

Open in new window


Author Closing Comment

ID: 31667806
I found my own solution, but the idea provided will be used in future projects.

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will help to fix the below error for MS Exchange server 2010 I. Out Of office not working II. Certificate error "name on the security certificate is invalid or does not match the name of the site" III. Make Internal URLs and External…
Simulator games are perfect for generating sample realistic data streams, especially for learning data analysis. It is even useful for demoing offerings such as Azure stream analytics, PowerBI etc.
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question