VBA code for Faxmaker

[rlmOC]

Hi,

I currently have a command button on my spreadsheet that will copy a specified range and automatically attach it using Faxmaker, the user is then taken to the Outlook screen where they currently have to type in [Fax:18889999999,18889999999] then click the send button in Outlook.

I would like the TO: field in Outlook to automatically populate with two numbers taken from the spreadsheet and then automatically send the fax.

I am not sure how to reference the TO: field or Send since faxmaker is already taking me to Outlook, so I don't believe I can create a Outlook Application.

Thanks in advance,

rlmOC

 

[CautionMP]

rlmOC,
So after the Faxmaker routine runs you have an open email message with no TO: address? If so you can grab the [tt]ActiveInspector[/tt], check if it is an email message ([tt]CurrrentItem.Class[/tt]), then add the [tt]Recipients[/tt].

Here is a sample that may work for you, it came from a previous project so it has a little extra error handling stuff in it but it should get you moving in the right direction, you will need to feed in the data from you spreadsheet into the [tt]Recipients[/tt] collection.

Sub CheckActiveInspector()
On Error GoTo CheckActiveInspector_Error
Dim appOutlook As Object
Dim objInspector As Object
Dim objCurrentItem As Object
Dim blnOutlookSpawned As Boolean
Set appOutlook = GetObject(, "Outlook.Application")
Set objInspector = appOutlook.ActiveInspector
Set objCurrentItem = objInspector.CurrentItem
If objCurrentItem.Class = 43 Then
  'objCurrentItem is olMail
  objCurrentItem.Recipients.Add "[b]Testing@tek-tips.com[/b]"
End If

Clean_up:
Set objCurrentItem = Nothing
Set objInspector = Nothing
If blnOutlookSpawned Then
  appOutlook.Quit
End If
Set appOutlook = Nothing
Exit Sub

CheckActiveInspector_Error:
Select Case Err.Number
  Case 91
    'There is no active inspector present
    MsgBox "There is no active inspector to grab", vbCritical, "Automation Error"
  Case 429
    'Outlook isn't open
    blnOutlookSpawned = True
    Set appOutlook = CreateObject("Outlook.Application")
    Resume Next
  Case Else
    Debug.Print Err.Number, Err.Description
End Select
Resume Clean_up
End Sub

NOTE: The [tt]ActiveInspector[/tt] is a best guess type of object, you cross your fingers and hope it represents what you want.

Hope this helps,
CMP

(GMT-07:00) Mountain Time (US & Canada)

 

[rlmOC]

Hey Caution,

Thanks for the reply, I will give this a try a little later when everyone is off the system.

Quick question though, I don't see where I would automatically be sending the fax. Not that it is a big deal, my main concern was populating the TO: field. Is the Send included in here somewhere?

Thanks

 

[CautionMP]

rlmOC,
Sorry I missed the Send. I added the subject for testing (I love sending myself emails)

...
If objCurrentItem.Class = 43 Then
  [green]'objCurrentItem is olMail[/green]
  With objCurrentItem
    .Recipients.Add "[i]Testing@tek-tips.com[/i]"
    [green]'.Subject = "Testing"[/green]
    [b].Send[/b]
  End With
End If
...

CMP

(GMT-07:00) Mountain Time (US & Canada)

 

[firefytr]

Take a look at 'Outlook Redemption' if you don't want any alerts to display when using the '.Send' method as compared to using the '.Display' method.

-----------
Regards,
Zack Barresse

 

[rlmOC]

Hi Caution,

The message box immediately pops up. Please see my code below:

Sub fax()
'

Sheets("quote").Range("D9:K9").Select
ActiveSheet.Unprotect Password:="rsx"
Sheets("quote").Range("A1:AD55").Select

Application.ActivePrinter = "FAXmaker on Ne00:"
Selection.PrintOut Copies:=1, ActivePrinter:="FAXmaker on Ne00:"

Range("D9:K9").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True


ActiveSheet.Protect Password:="rsx"

Call CheckActiveInspector


End Sub

Sub CheckActiveInspector()

On Error GoTo CheckActiveInspector_Error

Dim appOutlook As Object
Dim objInspector As Object
Dim objCurrentItem As Object
Dim blnOutlookSpawned As Boolean
Dim stRecipient As String

stRecipient = "[Fax:" & Sheets("inquiry").Range("g36").Value & _
"," & WorksheetFunction.VLookup(Sheets("inquiry").Range("g19"), _
Range("salesfax"), 2, False) & "]"

Set appOutlook = GetObject(, "Outlook.Application")
Set objInspector = appOutlook.ActiveInspector
Set objCurrentItem = objInspector.CurrentItem
If objCurrentItem.Class = 43 Then
With objCurrentItem
.Recipients.Add stRecipient
.Body = ""
.Send
End With
End If

Clean_up:
Set objCurrentItem = Nothing
Set objInspector = Nothing

If blnOutlookSpawned Then
appOutlook.Quit
End If
Set appOutlook = Nothing
Exit Sub

CheckActiveInspector_Error:
Select Case Err.Number
Case 91
msgbox "There is no active inspector to grab", vbCritical, "Automation Error"
Case 429
blnOutlookSpawned = True
Set appOutlook = CreateObject("Outlook.Application")
Resume Next
Case Else
Debug.Print Err.Number, Err.Description
End Select
Resume Clean_up

End Sub

Do you happen to have any other ideas?

Hey firefytr, recognize yuo from Mr. Excel!!!

I don't know anything about Redemption but I will check it out. I'll let you know if I need help (I'm sure I will).

rlmOC

 

[firefytr]

Well hello!

The Outlook OM really stinks (IMHO). You can't get around that native functionality (I call it a PITA) without Redemption. I don't know about OL 2007 though, haven't played with it much, although I really doubt you'd be able to as it's a security feature. Redemption is the only thing that I know of to cease the pop up message.

Btw, take a look at OutlookSpy too. It gives you more insight into the Oultook OM than any other source I've seen, it's a great tool.

-----------
Regards,
Zack Barresse

 

[CautionMP]

rlmOC,
You said that Faxmaker creates the email message for you? When it creates the email is the message open and ready for editing (in an Inspector window)?

Another thought is that the code is executing to quickly, [tt]Call CheckActiveInspector[/tt] happens before Faxmaker has a chance to connect/create/activiate the new email message. If this is the case adding [tt]DoEvents[/tt] after [tt]Selection.PrintOut[/tt] might solve the problem.

CMP

(GMT-07:00) Mountain Time (US & Canada)

 

[rlmOC]

Hi Caution,

Actually, you may be dead on with your assessment. After the Msgbox appeared and I clicked OK, I was taken to Outlook with the Fax attachment.

Could you help me with the DoEvents. I am a beginner and I am not quite sure what to do here.

Thanks,

rlmOC

 

[CautionMP]

rlmOC,
It's amazing how much time I have spent over the years making code run slower!

...
    Selection.PrintOut Copies:=1, ActivePrinter:="FAXmaker on Ne00:"
    [b]DoEvents[/b]
    Range("D9:K9").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
     
    ActiveSheet.Protect Password:="rsx"
    
    Call CheckActiveInspector
...

If that doesn't work we can throw a brick in [tt]CheckActiveInspector()[/tt] to slow it down.

CMP

(GMT-07:00) Mountain Time (US & Canada)

 

[rlmOC]

Hey Caution,

Looks like we need to throw a brick, same result after the DoEvents.

Hope you have a great weekend.

rlmOC

 

[CautionMP]

rlmOC,

Sub CheckActiveInspector()

On Error GoTo CheckActiveInspector_Error

Dim appOutlook As Object
...
[b]Dim intAttempts As Integer[/b]
...
CheckActiveInspector_Error:
Select Case Err.Number
    Case 91
      [b]intAttempts = intAttempts + 1
      'If 5 seconds isn't long enough...
      If intAttempts < 5 Then
        '0.0000115 is approx 1 second
        Application.Wait Now + 0.0000115
        Resume
      Else[/b]
        MsgBox "There is no active inspector to grab", vbCritical, "Automation Error"
      End If
    Case 429

CMP

(GMT-07:00) Mountain Time (US & Canada)

 

[rlmOC]

Hi Caution,

Well if anything, it sped up the time it takes for the msgbox to pop-up. (lol)

It is taking about 2-3 seconds and then the msgbox pops up. Once I click OK, I am taken to Outlook where the fax is attached.

rlmOC

 

[CautionMP]

rlmOC,
Are you getting the There is no active inspector to grab popup?

CMP

(GMT-07:00) Mountain Time (US & Canada)

 

[rlmOC]

Yes I am

 

[CautionMP]

rlmOC,
Got me. I'm sure it's a simple logic error but I'm just not seeing this morning. Try changing [tt]intAttempts[/tt] from 5 to 10 and see if that eliminates the popup.

The other thing I'm thinking is that error [tt]91[/tt] is being raised somewhere else in the process. You could check this by stepping through the procedure one step at a time to see where the errors are happening:
In the VBE window[ul]
[li]Tools => Options[/li]
[li]General tab[/li]
[li]Error Trapping => Break on All Errors[/li][/ul]
This will stop the routine when an error is encountered and highlight where the error is. If the following line is hightlighted:
[tt][highlight]Set objInspector = appOutlook.ActiveInspector[/highlight][/tt]
That's ok, it's the error we are trying to capture. You can press [tt]F5[/tt] or press the play button to continue, if it stops somewhere else with error [tt]91[/tt] that may be why the [tt]intAttempts[/tt] counter is going over 5 even though Faxmaker is creating the new message.

CMP

(GMT-07:00) Mountain Time (US & Canada)

 

[rlmOC]

Hi Caution,

By setting the Error trapping to break on all errors, Once the Fax button was clicked, I received the following:

Run Time error 429
ActiveX component can't create object

The line of code highlighted is:

Set appOutlook = Get Object(, "Outlook.Application")

I hope this gets you closer. I really appreciate all your time and effort to this point.

rlmOC

 

[CautionMP]

rlmOC,
So I'm guessing that Outlook was closed when you clicked the Fax Button? If so this is good since we are handling this error.

If you press play ([tt]F5[/tt]) the code will continue. The next error should be error 91 (from the earlier post), you will get this a couple times as Faxmaker spawns a new email.

You will be looking for any errors in the code after this line:
[tt]Set objInspector = appOutlook.ActiveInspector[/tt]

CMP

(GMT-07:00) Mountain Time (US & Canada)