Solved: TAPI + Dialer.exe, To place Telephone Calls

[D_Rennie]

Hello.

Starting from (post count <5 so i have to link like this, Sorry)
support.microsoft.com/kb/141625 I've managed to make outgoing phone calles quite easly.

Though With this code. Dialer.exe requires extra User imput to initialize the line and also to releace the line then close dialer.exe
This is just extra user imput that is not needed in my case.

The way i see it if the button in Excel has been pressed and confermed. I want to make the call.
I dont want to use Head-Sets or the sound card. Just pick up a handset for that phone line after that the modem can hang up while I continue talking.

From what i can find is Dialer.exe or Equevlant needs to be used. Though a solution of passing The controls for these instances.

Came across what looks to be the complete code for what im trying to achive.
Could you please Let me know how to make everythink work together. I think its all there just needs someone with better skills than me to work it.

Thankyou.

D_Rennie

[D_Rennie]

Example Of Code

'Option Compare Database
Option Explicit
Const WM_CLOSE = &H10
Const SW_HIDE = 0
'API use default Windows Phone Dialer
Private Declare Function tapiRequestMakeCall _
Lib "TAPI32.DLL" _
( _
ByVal DestAddress As String, _
ByVal AppName As String, _
ByVal CalledParty As String, _
ByVal Comment As String _
) _
As Long
'API sleep to give user time to pick up phone
Private Declare Sub Sleep _
Lib "kernel32" _
( _
ByVal dwMilliseconds As Long _
)
'API find application by full caption
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" _
( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) _
As Long
'API bring Window to foreground
Private Declare Function SetForegroundWindow _
Lib "user32" _
( _
ByVal hwnd As Long _
) _
As Long
'API send message to application
Private Declare Function PostMessage _
Lib "user32" _
Alias "PostMessageA" _
( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) _
As Long

Private Function CloseDialer(AppCaption As String)
Dim hwnd As Long
hwnd = FindWindow(vbNullString, AppCaption)
If hwnd <> 0 Then
'Bring to Front
SetForegroundWindow hwnd
'Close the app nicely
PostMessage hwnd, WM_CLOSE, 0&, 0&
'"Are you sure" dialog is received here
' how to send "Are you sure" dialog a Yes response?
'FindWindow ("Dialer") ???
'PostMessage hwnd, "Yes" ???
End If
End Function


Private Sub CommandButton1_Click()
On Error GoTo HandleErr
Dim objDialer As Object
Dim strMsg As String
Dim varReturn As Long
Dim intX As Integer
Dim varDialWait As Variant
Dim strDial As Variant
Dim j As Variant
Dim lngRetVal As Long
Dim i As Integer
Dim n As String
Dim p As String
Static blnDialing As Boolean 'prevent reentry into sub while dialing
DoEvents
If blnDialing Then Exit Sub
strDial = Trim$(Me!TelNumber)
For i = 1 To Len(strDial)
n = Mid(strDial, i, 1)
If n Like "#" Then p = p & n
Next i
strDial = "+1" & Format(Left(p, 10), "(@@@)&&&-&&&&")
lngRetVal = tapiRequestMakeCall(strDial, "", "", "faxback")
If lngRetVal = 0 Then
blnDialing = True
For intX = 1 To 8 'user has 8 seconds to pick up phone
DoEvents
Sleep 1000
Next
End If
Exit_Here:
On Error Resume Next
blnDialing = False
CloseDialer ("Phone Dialer")
Exit Sub
HandleErr:
Select Case Err.Number
Case 94 'Invalid Use of Null - if double-click on blank
'in this case, just open the dialer
Set objDialer = CreateObject("Scripting.FileSystemObject")
If objDialer.FileExists("c:\Program Files\WindowsNT\dialer.exe") Then
Call Shell("c:\Program Files\Windows NT\dialer.exe", vbNormalFocus)
ElseIf objDialer.FileExists("c:\Windows\dialer.exe") Then
Call Shell("c:\Windows\dialer.exe", vbNormalFocus)
End If
Set objDialer = Nothing
Exit Sub
Case Else
'modHandler.LogErr ("frm0Telephone"),

End Select
Resume Exit_Here
End Sub

Workbook Example.

[D_Rennie]

There are some things that i hope someone here can help out with.

The code opens dialer.exe and dials the number though when it tries to close dialer.exe still has the phone line open and the program has the msgbox you are still in a call are you sure you want to quit.
So im guessing that the line needs to be closed before the application quit.

[Aussiebear]

Can you explain to me just how this thread relates to Excel?

[D_Rennie]

I have a excel contacts userform and want to add this to it.
Probley not a typical thing to do in VBA though im not the typical type.
Its somethink that intrest me and i though i would give it a shot. First time the 56k modem has seen the light of day in a while.
Cheers,

[D_Rennie]

Edit Edit Edit

[D_Rennie]

I've found somethink that works.

Option Explicit
Const WM_CLOSE = &H10
Const WM_DESTROY = &H2
'Const SW_HIDE = 0
Const WM_SETTEXT = &HC
Const WM_COMMAND = &H111
Const VK_RETURN = &HD
Const WM_CHAR = &H102
Const WM_KEYDOWN = &H100
Const WM_KEYUP = &H101
Const VK_SPACE = &H20

Const GW_CHILD As Long = 5
'Const WM_CHAR = 258
Const VK_F10 = &H79
Const VK_F5 = &H74
Const VK_L = &H4C

Const SW_HIDE = 0
Const SW_SHOW = 5

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'API use Phone Dialer to make call
Private Declare Function tapiRequestMakeCall Lib "TAPI32.DLL" _
(ByVal DestAddress As String, ByVal AppName As String, ByVal CalledParty As String, _
ByVal Comment As String) As Long

'API find applcation by full caption
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'API bring Window to foreground
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

'API set ShowWindow to hide window
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long)

'API send message to application
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long

Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long


Private Const INFINITE = -1&
Private Const SYNCHRONIZE = &H100000


Private Sub Phone_Click()
On Error GoTo HandleErr
Dim varDialWait As Variant
Dim varStart As Variant
Dim lThreadId As Long, lProcessId As Long, ret As Long
Dim strDial As String
Dim lngRetVal As Long
Static blnDialing As Boolean 'prevent reentry into sub while dialing
DoEvents
blnDialing = False
If blnDialing Then Exit Sub
strDial = Me.TelNumber

Label6.Caption = "Calling TAPI ..."

lngRetVal = tapiRequestMakeCall(Trim$(strDial), "", "", "")
If lngRetVal = 0 Then
blnDialing = True

Dim strMsg As String
Dim varReturn As Long, lngX As Long

Label1.Caption = "You have 10 seconds to Pick up the Phone to Talk! ..."

For lngX = 1 To 7 ' This needs to be adjusted for slow or faster modems, Or 'pulse dial.
' mine works at about 7sec for 14 digits.
'
''''
Label6.Caption = "Waiting " & 11 - lngX & " ..."
DoEvents
Sleep 1000 ' sleep 1 second 'This needs to be adjusted for slow or faster modems
Next lngX

Label6.Caption = "Ready for next call ..."

End If

Dim AppCaption As String
Dim hwnd As Long


'hwnd = FindWindow(vbNullString, AppCaption)


hwnd = FindWindow(vbNullString, "Call Status")
If hwnd <> 0 Then
Call SendMessage(hwnd, WM_CLOSE, 0&, 0&)
End If

hwnd = FindWindow(vbNullString, "Phone Dialer")
If hwnd <> 0 Then

PostMessage hwnd, WM_CLOSE, 0&, 0&
End If

hwnd = FindWindow(vbNullString, "Dialer")
If hwnd <> 0 Then

PostMessage hwnd, WM_KEYDOWN, VK_RETURN, 0
PostMessage hwnd, WM_KEYUP, VK_RETURN, 0
End If

Label1.Caption = "Number to call"

Exit Sub
HandleErr:
Select Case Err.Number
Case 94 'Invalid Use of Null - if double-click on blank, open dialer
MsgBox "here" 'Call Shell("c:\windows\dialer.exe", vbNormalFocus)
Exit Sub
Case Else
'modHandler.LogErr ("frm0Telephone"),("Telephone_Numbers_DblClick" )
End Select
'Resume Exit_Here
End Sub


IT works well though must admit acts and looks a little clumsly.
Would be better if the windows where hidden from view.
And (A flaw) that if the mouse is click during the time dialer.exe is open it fails to close the program completly.

Thankyou.