excl 透過OLE來使用whfc傳真

如果你有使用 whfc(widows hylafax  client)及hylafax傳真伺服器請參閱下面:
以下是我參照whfc網站上的ole所寫成的
在EXCL中透過巨集使用OLE來傳真的程式碼(VBS)
Function SendFax(faxnum)

Dim fax_location As String
Dim whfc As Object
Dim OLE_Return As Long
Dim SpoolFile As String
Dim Titel As String
Dim WhfcPrinter As String
Dim Box_Return As Integer
'暫存檔
SpoolFile = "c:\test.ps"
Titel = "Whfc OLE Makro ( Version 0.01alpha )"
'使用 Application.Version來取得excel的版本
'Excel Version 8.0 (97) 不支援參數prtofilename(print to file name),因此會磞出一個視窗來要你指定檔名
'Excel Version 9.0 (2000)則以下
'-----------------------
Select Case Application.Version
Case Is = "8.0": Application.ActivePrinter = "Whfc on WHFCFAX:"
ActiveSheet.PrintOut copies:=1, collate:=True, PrintToFile:=True
Case Is = "9.0": Application.ActivePrinter = "Whfc 在 WHFCFAX:"
ActiveSheet.PrintOut Copies:=1, Collate:=True, PrintToFile:=True, prtofilename:=SpoolFile
Case Else: MsgBox ("本程式不援你Excel的版本")
Exit Function
End Select
'=======================================================
'本註解是使用Redmon列表機轉向程式,一般使用者可以略過
'Select Case Application.Version
'Case Is = "8.0": Application.ActivePrinter = "psprint on RPT1:"
' ActiveSheet.PrintOut copies:=1, collate:=True
'Case Is = "9.0": Application.ActivePrinter = "psprint 在 RPT1:"
' ActiveSheet.PrintOut copies:=1, collate:=True
'Case Else: MsgBox ("本程式不支援你的Excel版本")
' Exit Function
'End Select
'================================================================
Set whfc = CreateObject("WHFC.OleSrv")
OLE_Return = whfc.SendFax(SpoolFile, faxnum, True)
MsgIcon = 16
Select Case OLE_Return
Case Is > 0: return_message = "你的傳送工作已交付傳真伺服器,工作ID=" + Str(OLE_Return)
MsgIcon = 0
Case Is = -1: return_message = "無法和傳真伺服器連線!"
Case Is = -2: return_message = "傳真號碼錯誤!"
Case Is = -3: return_messsage = "傳送檔不存在!"
End Select
Box_Return = MsgBox(return_message, MsgIcon, Titel)
Set whfc = Nothing


End Function





Sub Arri_Notice()
' 以下是另一個呼叫前面函式來送傳真
' Macro6 巨集表
' csc 在 2002/1/24 錄製的巨集
'
celllocate = ActiveCell.Address
rowlocate = Trim(Mid(Trim(celllocate), 4, 3))
eta = Cells(1, 2).Value
company = Cells(rowlocate, 1).Value
fax_number = Cells(rowlocate, 2).Value
If (Len(fax_number) = 0) Then

MsgBox ("所在位列數,傳真號碼不存在,無法傳真!")
Else
ocean_freight = Cells(rowlocate, 3).Value
thc = Cells(rowlocate, 4).Value
dof = Cells(rowlocate, 5).Value
other = Cells(rowlocate, 6).Value
Sheet1.Activate
Range("b6") = company
Range("e6") = fax_number
Range("d7") = eta
Range("f10") = ocean_freight
Range("f11") = thc
Range("f12") = dof
Range("f13") = other
SendFax (fax_number)

Cells(1, 1).Select
End If

End Sub


whfcole函式:

       藍色比較有用

BSTR GetPhoneBook(Index)

index取得電話簿名稱

傳 回 電話簿的名稱或是null(超過電話簿的數量)

long SendFax(
檔名,傳真號碼, RmFile)
FileNameString  .ps 或是.pdf 或是純文字(不可包含中文)
FaxNoString
傳真號碼,可以指定多個傳真號碼使用逗號分開(依據你的設定應該是"分號").
RmFileBOOLturn
傳 送後是否刪除,.
RETURNLong
傳回值


工作id


無法傳送檔案到server


傳真號碼有錯


檔案不存在


long SendFaxDlg(FileName, RmFile)
同上只是多蹦出一個視窗讓你填入 傳真號碼

傳 回值

>0

工作id

-1

無法傳送檔案到server

-2

傳真號碼有錯

-3

使用者中斷傳真.在傳真對話中,使用者按了cancel

-4

檔案不存在


long SendFaxPhoneBook(FileName, FaxNo, PhoneBook, RmFile)

同 上,如 果使用者的faxno不是數字會查詢phonebook的名稱找到其傳真號碼

傳 回值

>0

工作id

-1

無法傳送檔案到server

-2

傳真號碼有錯

-4

檔案不存在

-5

電話簿不存在


無法開啟電話簿

-7

在電話簿中無法找到傳真號碼

BOOL AsyncSendFax(FileName)

傳 送一個文件到伺服器,蹦 出傳真的對話框.立 即傳送不等待.而 檔案傳送到伺服器刪除.
永遠傳回true

BOOL AsyncSendFaxDocDialog(FileName, DocName)
同上
但給定docname 是文件在伺服器的名稱
BSTR ResolveFaxNo(Alias, PhoneBook,ErrCode )
由傳真的名稱到phonebook中找到電話號碼

傳 回傳真號碼,如 果找不到傳回null

LONG GetInfo(Alias, PhoneBook,FaxNo,To,Company,Location,VoiceNo, Remarks,Lpi )
取得電話簿所有的資料
LpiSHORTP
解析度(0 = 98lpi 1 = 196 lpi)

回 傳值

 0

成功

-2

無效傳真號碼

-5

電話簿不存在

-6

雷話簿無法開啟

-7

尋找的名稱不存在電話簿中