Option Compare Database
Option Explicit
Declare Function WriteFile& Lib "kernel32" _
(ByVal hFile As Long, lpBuffer As Any, _
ByVal nNumberOfBytesToWrite&, _
lpNumberOfBytesWritten&, ByVal lpOverlapped&)
Declare Function CreateFile& Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName$, ByVal dwDesiredAccess&, _
ByVal dwShareMode&, ByVal lpSecurityAttributes&, _
ByVal dwCreationDisposition&, ByVal dwFlagsAndAttributes&, _
ByVal hTemplateFile&)
Declare Function CloseHandle& Lib "kernel32" (ByVal hObject&)
Declare Function FlushFileBuffers& Lib "kernel32" (ByVal hFile&)
' The number of seconds to wait for the modem to dial before
' .. resetting the modem. If the phone hangs up prematurely
' .. try increasing this value by small increments.
Public Const WAITSECONDS = 4
Public Const ID_CANCEL = 2
Public Const MB_OKCANCEL = 1
Public Const MB_ICONSTOP = 16, MB_ICONINFORMATION = 64
Function DialNumber(PhoneNumber, CommPort As String)
' PURPOSE: To dial a telephone number using the computer's modem
' ARGUMENTS:
' PhoneNumber: The telephone number to dial
' CommPort: The communications port the modem is connected
' to. Typically, modems are found on COM2, however,
' they can be configured for any COM port.
'
' EXAMPLE:
' Type the following in the Immediate window using a modem
' connected to the COM2 port:
'
' ? DialNumber("555-1212", "COM2")
'
' ***********************************************************
Dim Msg As String, MsgBoxType As Integer, MsgBoxTitle As String
Dim bModemCommand(256) As Byte, ModemCommand As String
Dim OpenPort As Long
Dim RetVal As Long, RetBytes As Long, i As Integer
Dim StartTime
' Ask the user to pick up the phone.
Msg = "Please pickup the phone and choose OK to dial " _
& PhoneNumber
MsgBoxType = MB_ICONINFORMATION + MB_OKCANCEL
MsgBoxTitle = "Dial Number"
If MsgBox(Msg, MsgBoxType, MsgBoxTitle) = ID_CANCEL Then
Exit Function
End If
' Open the communications port for read/write (&HC0000000).
' Must specify existing file (3).
OpenPort = CreateFile(CommPort, &HC0000000, 0, 0, 3, 0, 0)
If OpenPort = -1 Then
Msg = "Unable to open communication port " & CommPort
GoTo Err_DialNumber
End If
' Send the telephone number to the modem.
ModemCommand = "ATDT" & PhoneNumber & vbCrLf
' Pack the string in a Byte array.
For i = 0 To Len(ModemCommand) - 1
bModemCommand(i) = Asc(Mid(ModemCommand, i + 1, 1))
Next
' Write the string to the Com port.
RetVal = WriteFile(OpenPort, bModemCommand(0), _
Len(ModemCommand), RetBytes, 0)
If RetVal = 0 Then
Msg = "Unable to dial number " & PhoneNumber
GoTo Err_DialNumber
End If
' Flush the buffer to make sure it actually wrote
RetVal = FlushFileBuffers(OpenPort)
' Wait WAITSECONDS seconds for the phone to dial.
StartTime = Timer
While Timer < StartTime + WAITSECONDS
DoEvents
Wend
' Reset the modem and take it off line.
ModemCommand = "ATH0" & vbCrLf
' Pack the byte array again.
For i = 0 To Len(ModemCommand) - 1
bModemCommand(i) = Asc(Mid(ModemCommand, i + 1, 1))
Next
RetVal = WriteFile(OpenPort, bModemCommand(0), _
Len(ModemCommand), RetBytes, 0)
'Flush the buffer again.
RetVal = FlushFileBuffers(OpenPort)
' Close the communications port.
RetVal = CloseHandle(OpenPort)
Exit Function
Err_DialNumber: 'This is not an On Error routine.
Msg = Msg & vbCr & vbCr & _
"Make sure no other devices are using Com port " & CommPort
MsgBoxType = MB_ICONSTOP
MsgBoxTitle = "Dial Number Error"
MsgBox Msg, MsgBoxType, MsgBoxTitle
End FunctionFormda telefon numarasinin textboxi TelefonNo ise, butonun tiklandiginda olayina bu kodu ekle
=DialNumber([Metin0];"COM2")Kodu olay yordami olarak degil, tiklandiginda kismina direkt yaz.
