Help send fax via Outlook using AccessDB. Not using SendObject command

[jimtmelb1]

Hi,
I have an Access 2000 database. I use the following code to transfer a document/s via email within my Access database. It uses automation with MS Outlook.

It works successfully. Can i use the same code but modify it slightly so it can send faxes via Outlook Fax Starter. I can do it manually but now i want to automate the process within Access.

Normamly in Outlook you would go to File -> New -> Fax Message and then insert the fax number and any attachments.
Can this process be done in code. I would much appreciate if somebody can show me how.

I have tried inserting [fax@faxnumber] instead of an email address in my Access database but it does not work. It still tries to send an email.

Thanking any that can help
Jim


Set olkApp = New Outlook.Application
Set olkNameSpace = olkApp.GetNamespace("MAPI&quot
Set objMailItem = olkApp.CreateItem(olMailItem)

olkApp.Session.Logon

With objMailItem

email = Forms![F_Base Info - Purchaser - Word Document]![EmailAddress]
.To = email

Do While i > 0
Set objOutlookAttach = .Attachments.Add(AttachPath(i - 1))
i = i - 1
Loop
.Display

End With

olkApp.Session.Logoff
Set objMailItem = Nothing
Set olkNameSpace = Nothing
Set olkApp = Nothing

 

[devangelista]

Hello,

I've had this problem as well. Here's the solution that I've come up with.

You should probably use a program like Win-Fax Pro and then use the following module - works like a champ. I have a database that builds dynamic queries and reports for customers, then faxes each one to customers based on the fax number in the database.

Sorry up front for the long post!

This is also a great resource for those out there that need some VBA code:

http://www.mvps.org/access/

Here's the module that I use to send faxes:


Option Compare Database
Option Explicit

Global strInvoiceWhere ' Global for both MSFax and WinFax examples

Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal IpClassName As String, ByVal IpWindowName As String) ' WinFax only








'********************************************************************************************
' This function will walk through the Customers table and fax the Invoices report which
' is filtered by the CustomerId field using MSFax through Access SendObject.
'
' This function assumes the report rptMSFaxInvoices has the default printer set to MSFax
' and the MSFax driver is installed correctly.
' *******************************************************************************************
'
Function MSFaxInvoices()

'********************************************************************************************
' Diming all variables
'********************************************************************************************

Dim dbsNorthwind As DATABASE
Dim rstCustomers As Recordset

'********************************************************************************************
' Setting database and recordset variables
'********************************************************************************************

Set dbsNorthwind = CurrentDb()
Set rstCustomers = dbsNorthwind.OpenRecordset("Customers", dbOpenDynaset) ' Set Recordset to Customers table

'********************************************************************************************
' Walking through the Customers recordset until end of file, setting the global variable
' strInvoicesWhere to the current where and using SendObject passing
' customers fax number and report name.
'********************************************************************************************

If MsgBox("Do you want to fax invoices" & Chr(13) & "to all customers using MSFax?", 4) = 6 Then
With rstCustomers
Do Until .EOF
strInvoiceWhere = "[customerid] = '" & ![CustomerID] & "'" ' sets global strInvoiceWhere
DoCmd.SendObject acReport, "rptMSFaxInvoice", acFormatRTF, "[fax: " & ![Fax] & "]", , , , , False ' Runs Report to MSFax
.MoveNext ' Move to next record in Recordset
Loop
End With
End If


End Function





'********************************************************************************************
' This function will walk through the Customers table and fax the Invoices report which
' is filtered by the CustomerId field using the user defined function SendWinFax. SendWinFax
' is located in this module.
'
' This function assumes the report rptWinFaxInvoices default printer is set to Delrina
' MAPI Services and WinFax Pro is correctly installed.
' *******************************************************************************************
Function WinFaxInvoices()

'********************************************************************************************
' Diming all varibles
'********************************************************************************************

Dim dbsAllotFax As DATABASE
Dim rstCustomers As Recordset
Dim intSendFaxReturnVal As Integer

'********************************************************************************************
' Setting database and recordset varibles
'********************************************************************************************

Set dbsAllotFax = CurrentDb()
Set rstCustomers = dbsAllotFax.OpenRecordset("Companies", dbOpenDynaset) ' Set Recordset to Customers table

'********************************************************************************************
' Walking throgugh the Customers recordset until end of file, setting the golbal varible
' strInvoicesWhere to the current where and calling SendWinFax passing the Customers Name,
' Customers Fax number and Report name.
'********************************************************************************************

intSendFaxReturnVal = -1 ' Priming return value to True
If MsgBox("Do you want to fax the ADS Reports " & Chr(13) & "to all customers using WinFax?", 4) = 6 Then ' Make sure user wants to send fax to customers
intSendFaxReturnVal = -1 ' Priming return value to True
With rstCustomers
Do Until .EOF Or intSendFaxReturnVal = 0 ' start do until end of file or return value = false
'strInvoiceWhere = "[customerid] = '" & ![CustomerID] & "'" ' sets global strInvoiceWhere
intSendFaxReturnVal = SendWinFax(![Name], ![Fax_Number], "ADSPaymentListing&quot 'Call user defined function and pass in data
.MoveNext ' Move to next record in Recordset
Loop
End With
End If

End Function

'
'
'********************************************************************************************
' Create Date 4/15/96
'
' SendWinFax function will fax any report to any phone number, and address it to any name
' which was provided in the variables.
'
' This function was *ONLY* tested under Win95 and WinFax 7.0 with the patch installed
' from Delrina. The patch "wf702d1.exe" can be found on

http://www.delrina.com.

' Without the patch you may get IPF's when running this code.
'
'************Microsoft Product Support only supports Microsoft Products.*********************
'
'********************************************************************************************
'
'
'
Function SendWinFax(strFaxName As String, strFaxNumber As String, strReportName As String) As Integer

'********************************************************************************************
' Diming all variables
'********************************************************************************************

Dim lngChannelNumber As Long
Dim strFaxStatus As String
Dim FaxTime As String
Dim strRecipFaxNum As String
Dim strRecipTime As String
Dim strRecipDate As String
Dim strRecipName As String
Dim strRecipient As String

On Error GoTo SendWinFax_Error 'Error Trap

'********************************************************************************************
' If WinFax is closed then none of the fax functionality will be run.
' Be aware that there may be timing issues when trying to start WinFax in this function.
' I elected to have the user start WinFax manually for this example.
'********************************************************************************************

'If FindWindow("Sfaxmng", "Delrina Winfax PRO&quot > 0 Then

'********************************************************************************************
' Building Recipient string to send in DDEPoke
'********************************************************************************************

strRecipFaxNum = Chr$(34) & strFaxNumber & Chr$(34)
strRecipTime = Chr$(34) & Format$(Now, "h:nn:ss&quot & Chr$(34)
strRecipDate = Chr$(34) & Date & Chr$(34)
strRecipName = Chr$(34) & left$(strFaxName, 24) & Chr$(34)

strRecipient = strRecipFaxNum & "," & strRecipTime & "," & strRecipDate & "," & strRecipName

'********************************************************************************************
' Start of DDE section
'********************************************************************************************

lngChannelNumber = DDEInitiate("faxmng32", "CONTROL&quot 'Initiate DDE connection
strFaxStatus = DDERequest(lngChannelNumber, "STATUS&quot 'Get and set status of DDE connection

'If busy then loop until not busy
While strFaxStatus Like "Busy*"
strFaxStatus = DDERequest(lngChannelNumber, "STATUS&quot
Wend

lngChannelNumber = DDEInitiate("FAXMNG", "TRANSMIT&quot 'set ChannelNumber to current DDE Channel

DDEPoke lngChannelNumber, "Sendfax", "recipient(" & strRecipient & &quot" 'Poke recipient data
DDEPoke lngChannelNumber, "Sendfax", "showsendscreen(""0"&quot" 'Poke to showscreen

'DDEPoke lngChannelNumber, "Sendfax", "setcoverpage(""Cover Page"" )" 'Untested Other Poke examples
'DDEPoke lngChannelNumber, "Sendfax ", "fillcoverpage(""Stuff to go inside."&quot" 'Untested Other Poke examples
'DDEPoke lngChannelNumber, "SendFax", "resolution(""HIGH"&quot" 'Untested Other Poke examples

'********************************************************************************************
' Run the Report
'********************************************************************************************
DoCmd.OpenReport strReportName, A_NORMAL

SendWinFax = -1 ' setting return value to True

'Else 'If WinFax is not started
' MsgBox "Please Start WinFax and try again" 'Prompt
' SendWinFax = 0 ' setting return value to False
'End If

'********************************************************************************************
' Exit Stuff
'********************************************************************************************

SendFax_Exit:

DDETerminateAll 'Terminate all links.
lngChannelNumber = False 'Set lngChannelNumber to false clears the varible.
Exit Function 'All Done

'********************************************************************************************
' Error Trap
'********************************************************************************************

SendWinFax_Error:
MsgBox "Error:" + Error$, 0, "SendFaxl" 'Print Error message and number
Resume SendFax_Exit


End Function

 

[jimtmelb1]

Thanks for your help Devangelista.

But how can i send say a Word Document. I need to send doc more than reports within my database.

Thanks again
Jim

 

[cjoan75]

I am not sure about DDE Poke but I have acheived this through creating the fax object, then selecting the objects I want to attach and send the fax(WinFax > v9). Here is the code below for the object, I am still trying to get the CDSKLog object to work. BTW, when I orginally got the code off another list it didn't work especially the DefaultPrinter code.

' Call SendMSFax("rptGroupCheckInProcedures-Union", strAreaCode, strPhone, intCustID)

'You send the FAX with this code - I have it in a module but I can't remember
'where I got the original from:

'********************************************
Option Compare Database
Option Explicit

Type ljg_Device_Nm
drDeviceName As String
drDriverName As String
drPort As String
End Type

Type ljg_Org_Device_Nm
drDeviceName As String
drDriverName As String
drPort As String
End Type

Dim dr As ljg_Device_Nm
Dim org_dv As ljg_Org_Device_Nm
Dim int_Dflt As Boolean

Dim dr_Device As String
Dim dr_Driver As String
Dim dr_Port As String

Dim strTo As String
Dim strCompany As String
Dim strSubject As String

Dim strMsg As String
Dim strTitle As String

Dim intMBType As Integer
Dim intI As Integer

Public Const cMAx_Size As Integer = 255

Declare Sub SleepAPI Lib "Kernel32" Alias "Sleep" (ByVal MSTime As Long)

Declare Function bc_api_GetProfileString Lib "Kernel32" Alias "GetProfileStringA" (ByVal strAppName As String, ByVal strKeyName As String, ByVal strDefault As String, ByVal strReturned As String, ByVal lngSize As Long) As Long
Declare Function bc_api_WriteProfileString Lib "Kernel32" Alias "WriteProfileStringA" (ByVal strAppName As String, ByVal strKeyName As String, ByVal strValue As String) As Integer
Declare Function bc_api_GetProfileSection Lib "Kernel32" Alias "GetProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long

Function SendFax(argReportName As String, argAreaCode As String, argPhoneNumber As String, argCustID As Integer, argCountryCode As String, argExtension As String) As Integer
'Error-handler inserted on 11/27/2003 at 11:03 by Henri St.Louis
'Comments/Description:
'------------------
'Modified History:
'-------------------
'27 Nov 03 - Added different object since have MS Fax on dev system not WinFax
'27 Nov 03 - Added Lookup for company name & contact info
'22 Dec 03 - Added Null check for contact info
'22 Dec 03 - Got get default & set default printer working
'6 Jan 04 - Added Country code variable
'8 Jan 04 - Added extension variable
'
On Error GoTo SendFax_Error
Dim strOldPrinter As String, strNewPrinter As String, drv As ljg_Org_Device_Nm

'--------------- Get Defalt Printer info & sav
If ljg_GetDefaultPrinter(drv) Then
org_dv.drDeviceName = drv.drDeviceName ' Store original device name
org_dv.drDriverName = drv.drDriverName ' Store original device driver
org_dv.drPort = drv.drPort ' Store original device port
End If

'Change the defalt printer to WinFax 8.0 / 9 ----------------------------
dr.drDeviceName = "WinFax"
dr.drDriverName = "WinFax"
dr.drPort = "FaxModem" 'PUB:

If Not ljg_SetDefaultPrinter(dr) Then
MsgBox "Unable set Fax to the default printer."
End If

Dim objWFXSend As New wfxctl32.CSDKSend '<--- By using this line you get the pull down list of methods (Called Early Binding)
'Dim objWFXSend As Object '<--- If the above line give you problems use these two lines (Late Binding)
'Set objWFXSend = CreateObject(&quot;WinFax.SDKSend&quot


With objWFXSend

' 1 = hold in winfax; 0 = send now
' removed since not option on dev system .SetHold (0) '<---- Sometime is this is at the bottom of the code things hang up???

'Note if you set the below date - time WinFax Ignores the &quot;SetHold&quot; and sends the fax on the
' Appropriate Date and Time - Note it cannot be past date or Time
'.SetDate (&quot;10/08/98&quot
'.SetTime (&quot;8:30:00&quot

'--- To:
.SetExtension (argExtension) 'Extension of fax
.SetCountryCode (argCountryCode) ' Country code of fax
.SetAreaCode (argAreaCode) ' Area code of fax
.SetNumber (argPhoneNumber) ' local number of fax

Dim strCustName As String, strFContact As String, strLContact As String
strCustName = DLookup(&quot;[CompanyName]&quot;, &quot;[CustomerTbl]&quot;, &quot;[CustomerID] = &quot; & argCustID)
strFContact = IIf(IsNull(DLookup(&quot;[ContactFirstName]&quot;, &quot;[CustomerTbl]&quot;, &quot;[CustomerID] = &quot; & argCustID)), &quot;&quot;, DLookup(&quot;[ContactFirstName]&quot;, &quot;[CustomerTbl]&quot;, &quot;[CustomerID] = &quot; & argCustID))
strLContact = IIf(IsNull(DLookup(&quot;[ContactLastName]&quot;, &quot;[CustomerTbl]&quot;, &quot;[CustomerID] = &quot; & argCustID)), &quot;&quot;, DLookup(&quot;[ContactLastName]&quot;, &quot;[CustomerTbl]&quot;, &quot;[CustomerID] = &quot; & argCustID))
.SetTo (strFContact & &quot; &quot; & strLContact)
.SetCompany (strCustName & &quot;&quot

'--- Billing code - KeyWords
'Sets the billing code field for the send job. This function returns 1 on
'error, 0 on OK. If this function is not used, WinFax defaults to no
'billing code.
.EnableBillingCodeKeyWords (1) '<-- You need to enable key codes first
' lngBillingcode = lngBillingcode + 22 ' Note you can lookup faxes on BillingCode and/or KeyWords
' You might want a number on the Access Record that is the same as Billing Code
.SetBillingCode (argCustID) '<-- You will need to show Billing code in WinFax folders to see the billing code
'.SetKeywords (&quot;Larry's the Key&quot '<-- You will need to show KeyWords in WinFax folders to see the KeyWords


'--- Add Recipient - You can loop through and add multiple recipiants
.AddRecipient

.SetPrintFromApp (1)

'.ShowSendScreen (1) '<------ I'don't understand what this does

'.SetResolution (intResolution) 'The below causes a creptic question to be asked at times - How do we stop that?

.SetDeleteAfterSend (0) '1= Delete fax after sending successfully 0=keep (0 default)


'1= shows progress screen 0= does not Show screen (1 default)
'.ShowCallProgess (1) '<---- Notice the 'r' missing this works in WinFax 8 & 9
.ShowCallProgress (1) '<---- Works only in WinFax9

' Start Faxing
.Send (1) 'Instructs WinFax to start the send process. Entry ID of resulting event
'may be requested using 1, 0 - no entry id requested. This function returns 1 on error, 0 on OK.

Do While .IsReadyToPrint = 0 'Returns 1 if WinFax is ready to accept a new print job. This is to be used when printing through the printer driver.
DoEvents
Loop

'Access97 command ********************
'If Me.GrpRpts = 1 Then
'If Me.GrpRpts = 1 Then 'Access Report
DoCmd.SelectObject acReport, &quot;NextServiceDueRpt&quot;, True
'End If

'Excel97 Command ********************
'ActiveSheet.PrintOut

'Word97 command ********************
'ActiveDocument.PrintOut
' .IsEntryIDReady
.GetEntryID (SendFax)


SleepAPI 200 ' Don't remove - tried 50, Send Dialog!
.Done
SleepAPI 200 ' Don't remove - tried 50, Send Dialog!
If .IsError = 1 Then
GoTo SendFax_NotifyUser
End If
End With

objWFXSend.LeaveRunning ' If we started WinFax with 'Dim objWFXSend As New wfxctl32.CSDKSend' this will leave it running.

SendFax_Close:
'--------------- Set back to old default printer
'If Me.GrpRpts = 1 Then 'Access Report
With dr
.drDeviceName = org_dv.drDeviceName
.drDriverName = org_dv.drDriverName
.drPort = org_dv.drPort
End With

If Not ljg_SetDefaultPrinter(dr) Then
MsgBox &quot;Unable to >>reset<< the default printer. Please attempt to do it manually.&quot;
End If

SendFax_Exit:
Exit Function

SendFax_NotifyUser:

MsgBox &quot;There was a problem encountered with the SendFax &quot; & _
&quot;Function, please ensure software is working.&quot;, _
vbExclamation + vbOKOnly + vbDefaultButton1, &quot;SendFax Function&quot;
GoTo SendFax_Close

SendFax_Error:
MsgBox &quot;Unexpected error - &quot; & Err.Number & &quot; &quot; & Err.Description & vbCrLf & &quot;EVAS_GoodFE - SendFax&quot;, vbExclamation
Resume SendFax_Exit
End Function
Function ljg_SetDefaultPrinter(dr As ljg_Device_Nm) As Boolean

'Accepts: ljg_SetDefaultPrinter(dr)
'Purpose: Sets the default printer through Windows API
'Returns: True if successful

On Error GoTo ljg_SetDefaultPrinter_Err
'If Programming_Mode Then On Error GoTo 0

'----
Dim strBuffer As String
'----

'-------- Build up the appropriate string.
strBuffer = dr.drDeviceName & &quot;,&quot;
strBuffer = strBuffer & dr.drDriverName & &quot;,&quot;
strBuffer = strBuffer & dr.drPort


'----------- Now write that string out to WIN.INI.
ljg_SetDefaultPrinter = (bc_api_WriteProfileString(&quot;Windows&quot;, _
&quot;Device&quot;, strBuffer) <> 0)

'----
'
ljg_SetDefaultPrinter_Done:
Application.Echo True
Exit Function

ljg_SetDefaultPrinter_Err:
MsgBox Err.Description, vbCritical, &quot;Error &quot; & Err
Resume ljg_SetDefaultPrinter_Done


End Function '----------------------------------

Function ljg_GetDefaultPrinter(drv As ljg_Org_Device_Nm) As Boolean

'Accepts: ljg_GetDefaultPrinter(dr)
'Purpose: 1) see if default printer exists
' 2) bring back Device - Driver - Port
'Returns: True/False if default exists
' Device - Driver - Port eq HP LaserJet 4 - HPPCL5MS - Lpt1:

On Error GoTo ljg_GetDefaultPrinter_Err
'If Programming_Mode Then On Error GoTo 0

'----
Dim strBuffer As String


Dim intTmp As Integer
Dim intTmp2 As Integer

Dim intChars As Integer
'---- do api to get default printer

strBuffer = String(cMAx_Size, 0)
intChars = bc_api_GetProfileString(&quot;Windows&quot;, &quot;Device&quot;, &quot;&quot;, strBuffer, cMAx_Size)
strBuffer = left(strBuffer, intChars)

If Len(strBuffer) > 0 Then
'------------------ Pull string apart -------------
intTmp = InStr(1, strBuffer, &quot;,&quot - 1
drv.drDeviceName = Mid(strBuffer, 1, intTmp)

strBuffer = Mid(strBuffer, intTmp + 2)
intTmp = InStr(1, strBuffer, &quot;,&quot - 1
drv.drDriverName = Mid(strBuffer, 1, intTmp)


drv.drPort = Mid(strBuffer, intTmp + 2)

ljg_GetDefaultPrinter = True
Else
ljg_GetDefaultPrinter = False
End If

'----
'
ljg_GetDefaultPrinter_Done:
Application.Echo True
Exit Function

ljg_GetDefaultPrinter_Err:
MsgBox Err.Description, vbCritical, &quot;Error &quot; & Err
Resume ljg_GetDefaultPrinter_Done


End Function '----------------------------------