Option Explicit '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 'FSO for fax status Dim fso1 As FileSystemObject Dim txtStream As TextStream 'User-defined Variables ... Private Type NOTIFYICONDATA cbSize As Long hwnd As Long uId As Long uFlags As Long uCallBackMessage As Long hIcon As Long szTip As String * 64 End Type 'Constants ... Private Const NIM_ADD = &H0 Private Const WM_MOUSEMOVE = &H200 Private Const WM_LBUTTONDOWN = &H201 Private Const NIF_MESSAGE = &H1 Private Const NIF_ICON = &H2 Private Const NIF_TIP = &H4 Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean 'Other Variables... Dim nid As NOTIFYICONDATA Private intMax As Long Dim FaxStatus As String 'Other Variables... ' Dim fso As New FileSystemObject ' Dim txtStream As TextStream Dim KFaxStatus As String 'Fax variables Dim faxstr Dim strFaxServer As String Dim strFaxNumber
Dim strFilePath Dim strFaxSubject Dim FromFax As String Public Function SendFax() As String 'Author: Kumar Date:25/03/03 'This function will send the fax job to the fax queue and generate a jobId On Error GoTo errlog Dim lJobId As Long strFaxServer = getComp 'faxstr(2) 'strFaxServer = "MAGNA1004" 'faxstr(2) strFaxSubject = "Prescription from Gea" 'faxstr(5) If strFilePath = "" Then Exit Function 'Dim fs As New FAXCOMLib.FaxServer Dim fs As Object 'Dim FD As New FAXCOMLib.FaxDoc Dim FD As Object Dim FaxServer As Object Set fs = CreateObject("FaxServer.FaxServer") ''''''''''Write Log Set fso1 = New FileSystemObject 'If fso1.FileExists("\\MAGNA1004\common\faxlog.txt") = False Then If fso1.FileExists("\\" & getComp & "\common\faxlog.txt") = False Then Set txtStream = fso1.CreateTextFile("\\" & getComp & "\common\faxlog.txt") 'Set txtStream = fso1.CreateTextFile("\\MAGNA1004\common\faxlog.txt") End If 'Set txtStream = fso1.OpenTextFile("\\MAGNA1004\common\faxlog.txt", ForAppending) Set txtStream = fso1.OpenTextFile("\\" & getComp & "\common\faxlog.txt", ForAppending) txtStream.WriteLine strFilePath txtStream.Close Set fso1 = Nothing ''''''''''''End log fs.Connect (strFaxServer) ' Local Computer name on which fax service and modem is configured ''''''''''Write Log Set fso1 = New FileSystemObject
'If fso1.FileExists("\\MAGNA1004\common\faxlog.txt") = False Then If fso1.FileExists("\\" & getComp & "\common\faxlog.txt") = False Then Set txtStream = fso1.CreateTextFile("\\" & getComp & "\common\faxlog.txt") 'Set txtStream = fso1.CreateTextFile("\\MAGNA1004\common\faxlog.txt") End If 'Set txtStream = fso1.OpenTextFile("\\MAGNA1004\common\faxlog.txt", ForAppending) Set txtStream = fso1.OpenTextFile("\\" & getComp & "\common\faxlog.txt", ForAppending) txtStream.WriteLine "Connected" txtStream.Close Set fso1 = Nothing ''''''''''''End log Set FD = fs.CreateDocument(strFilePath) FD.FileName = strFilePath ' attaching File FD.FaxNumber = strFaxNumber ' Fax number FD.DisplayName = strFaxSubject ''Display Name 'FD.SendCoverpage = 1 FD.ServerCoverpage = 0 'FD.CoverpageName = "c:\cover.cov" 'FD.CoverpageNote = "This is a test of the cover page" 'FD.SenderName = "GEA" FD.SenderCompany = FromFax 'FD.SenderOffice = "Hyd" 'FD.SenderFax = "121212"
'Timer2.Enabled = True lJobId = FD.Send ''Sending to Fax printer, status will be in Fax Que ''''''''''Write Log Set fso1 = New FileSystemObject 'If fso1.FileExists("\\MAGNA1004\common\faxlog.txt") = False Then If fso1.FileExists("\\" & getComp & "\common\faxlog.txt") = False Then Set txtStream = fso1.CreateTextFile("\\" & getComp & "\common\faxlog.txt") 'Set txtStream = fso1.CreateTextFile("\\MAGNA1004\common\faxlog.txt") End If 'Set txtStream = fso1.OpenTextFile("\\MAGNA1004\common\faxlog.txt", ForAppending) Set txtStream = fso1.OpenTextFile("\\" & getComp & "\common\faxlog.txt", ForAppending)
txtStream.WriteLine "Send" txtStream.Close Set fso1 = Nothing ''''''''''''End log Me.lJobId.Caption = lJobId Set FD = Nothing Set fs = Nothing Load frmStatus frmStatus.Show Exit Function ' ' ' ' ' ' '
Dim starttime starttime = Now Do While result <> 0 And DateDiff("n", Format(starttime, "h:mm"), Time) < 2
' ' ' '
fs.Disconnect Set FD = Nothing Set fs = Nothing
Debug.Print DateDiff("n", Format(starttime, "h:mm"), Time) result = UpdateJob(strFaxServer, lJobId) Loop
errlog: Set fso1 = New FileSystemObject 'If fso1.FileExists("\\MAGNA1004\common\faxlog.txt") = False Then If fso1.FileExists("\\" & getComp & "\common\faxlog.txt") = False Then Set txtStream = fso1.CreateTextFile("\\" & getComp & "\common\faxlog.txt") 'Set txtStream = fso1.CreateTextFile("\\MAGNA1004\common\faxlog.txt") End If 'Set txtStream = fso1.OpenTextFile("\\MAGNA1004\common\faxlog.txt", ForAppending) Set txtStream = fso1.OpenTextFile("\\" & getComp & "\common\faxlog.txt", ForAppending) txtStream.WriteLine Err.Description & Now & "Two" txtStream.Close Set fso1 = Nothing Debug.Print Err.Description If Trim(Err.Description) = "Method 'Connect' of object 'IFaxServer' failed" Then 'MsgBox "Error!!!Please check the fax service", vbCritical Debug.Print "Fax Service is down"
Else KFaxStatus = "Fax sending Failed. Error: " & Err.Description End If Set FD = Nothing Set fs = Nothing End Function