Attribute VB_Name = "InsGM2HylaFax"
'GoldMine 4.x Link for Microsoft Word 97
'CopyHyla GoldMine Software Corportation 1997, 1998
'WHFC Support updated by Sujay D'Souza / sad@acm.org

Dim to_$, company$, res$, mode$, GMCh, faxnum$, recipient$, defprn$

Public Sub Main()
to_$ = ""
company$ = ""
res$ = ""
mode$ = ""
GMCh = 0
faxnum$ = ""
recipient$ = ""
defprn$ = ""
    SubmitFax 0, 1, 0
End Sub

Private Function GetLinkName$()
  GetLinkName$ = "HylaFax"
End Function

Public Function OpenFax()
Dim FaxDevice$
    FaxDevice$ = WordBasic.[GetProfileString$]("devices", "HYLAFAX")
    If FaxDevice$ = "" Then
        OpenFax = -1
        WordBasic.AppMaximize "Microsoft Word", 1
        WordBasic.AppActivate "Microsoft Word", 1
        WordBasic.MsgBox "Faxing Aborted..." + Chr(13) + "Can Not Locate HylaFax", "GoldMine Link", 16
    GoTo byeOpenFax
    Else
        OpenFax = 0
byeOpenFax:
End If
End Function

Public Sub SubmitFax(ch, mode_, faxch)
Dim CloseGMDDE
Dim FaxNo$
    ' check for an open DDE channel to Goldmine
    GMCh = ch               ' assign goldmine dde channel to global
    If GMCh = 0 Then        ' need to initiate link with GoldMine
        If Not (WordBasic.AppIsRunning("GoldMine")) Then
            ' GoldMine is not running.
            WordBasic.MsgBox "GoldMine is NOT Running!", "Send Via WinFax", 16
            GoTo Exit_
        End If
        GMCh = WordBasic.DDEInitiate("GoldMine", "Data")
        CloseGMDDE = 1
    Else
        CloseGMDDE = 0
    End If

    AccNo$ = WordBasic.[DDERequest$](GMCh, "&AccountNo")
    FaxNo$ = WordBasic.[DDERequest$](GMCh, "&Fax")
    recipient$ = WordBasic.[DDERequest$](GMCh, "&Contact")
    company$ = WordBasic.[DDERequest$](GMCh, "&Company")

 'Set printer to HylaFAX
    defprn$ = WordBasic.Call("GMLib.GetPrinter$")
    SetHFxPrn (GMCh)

    SpoolFile$ = Environ("TEMP")
    If SpoolFile$ = "" Then
        SpoolFile$ = Environ("TMP")
    ElseIf SpoolFile$ = "" Then
        SpoolFile$ = Environ("WINDIR")
    ElseIf SpoolFile$ = "" Then
        SpoolFile$ = "C:"
    End If
    
    SpoolFile$ = SpoolFile$ + "\hylafax.ps"
    
    ActiveDocument.PrintOut Background:=False, Append:=False, range:=wdPrintAllDocument, _
    OutputFileName:=SpoolFile$, Item:=wdPrintDocumentContent, PrintToFile:=True
        
    Set objwhfc = CreateObject("WHFC.OleSrv")
    retole = objwhfc.SendFax(SpoolFile$, FaxNo$, True)
            
    If retole <= 0 Then
        retBox = MsgBox("Error Sending File; ErrCode = " + Str(retole), 16, "Send via HylaFAX")
    'Else
    '    retBox = MsgBox("Fax Queued; Transaction No. " + Str(retOle), 16, "Send via HylaFAX")
    End If
    
    Set objwhfc = Nothing
        
    WordBasic.Call "GMLib.SetPrinter", defprn$

Exit_:
    If CloseGMDDE Then
        WordBasic.DDETerminate GMCh
    End If

End Sub

Private Sub MergeFax(ch, faxch, FormNo$, NRec, NPages, MergeFileName$)
    WordBasic.PrintStatusBar "Faxing ... Please Wait"
    CreateMergeForm ch, FormNo$
    FaxMergeForm (NRec)
End Sub

Private Sub CreateMergeForm(ch, FormNo$)
Dim q$
Dim FaxNo$
    q$ = Chr(34)

    ActiveDocument.MailMerge.ViewMailMergeFieldCodes = True

    Call GoldMineLink.GetGMInfo(AccNo$, faxnum$, recipient$, company$)
    
    AccNo$ = Left(AccNo$, 20)
    faxnum$ = Left(faxnum$, 45)
    recipient$ = Left(recipient$, 30)
    company$ = Left(company$, 40)
    
    WordBasic.EndOfDocument

    'Set printer to HylaFax - Printer must be set to get Univers font.
    defprn$ = WordBasic.Call("GMLib.GetPrinter$")
    SetHFxPrn (ch)


    Call PutHFInfo1(AccNo$, faxnum$, recipient$, company$)

        
End Sub

Private Sub FaxMergeForm(NRec)
Dim i

    On Error GoTo -1: On Error GoTo ResetPrinter
   
   
    ActiveDocument.MailMerge.ViewMailMergeFieldCodes = True
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
    NRec = ActiveDocument.MailMerge.DataSource.ActiveRecord
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord
    
    For i = 1 To NRec
    
    ActiveDocument.MailMerge.ViewMailMergeFieldCodes = False
    Call GoldMineLink.GetGMInfo(AccNo$, faxnum$, recipient$, company$)
     
      
      If Not (faxnum$ = "" Or faxnum$ = "(   )   -") Then
      
        SpoolFile$ = Environ("TEMP")
       If SpoolFile$ = "" Then
          SpoolFile$ = Environ("TMP")
       ElseIf SpoolFile$ = "" Then
          SpoolFile$ = Environ("WINDIR")
      ElseIf SpoolFile$ = "" Then
          SpoolFile$ = "C:"
      End If
    
    SpoolFile$ = SpoolFile$ & "\hylafax" & i & ".ps"
    
    Application.PrintOut FileName:="", range:=wdPrintAllDocument, _
    Item:=wdPrintDocumentContent, Copies:=1, Pages:="", _
    PageType:=wdPrintAllPages, Collate:=True, Background:=True, _
    PrintToFile:=True, OutputFileName:=SpoolFile$, Append:=False


    Set objwhfc = CreateObject("WHFC.OleSrv")
    retole = objwhfc.SendFax(SpoolFile$, faxnum$, True)
    End If
    Set objwhfc = Nothing
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
    Next i

ResetPrinter:
            
     
    WordBasic.Call "GMLib.setprinter", defprn$
    'reset Default Printer
    WordBasic.Call "GMLib.SetPrinter", defprn$
    
End Sub

Private Sub SetHFxPrn(ch)
Dim FaxDevice$
Dim HFxdevice$
    ' Find and parse Winfax device string
    FaxDevice$ = WordBasic.[GetProfileString$]("devices", "HYLAFAX")
    HFxdevice$ = "HylaFax on " + WordBasic.[right$](FaxDevice$, (Len(FaxDevice$) - InStr(FaxDevice$, ",")))
    WordBasic.Call "GMLib.SetPrinter", HFxdevice$
End Sub
    

'
Private Sub PutHFInfo(sAccNo, sFaxNum, sRecipient, sCompany)
'
'
'
    Application.ScreenUpdating = False
    
    
    Call ClearHFInfo
    
    Set MyStyle = ActiveDocument.Styles.Add(Name:="gmHylaFaxInfo", _
      Type:=wdStyleTypeCharacter)
    
    With MyStyle.Font
      .Size = 2
      .Bold = 0
      .Italic = 0
      .Underline = 0
      .Name = "Univers"
    End With
    
    Call Selection.EndKey(Unit:=wdStory)
    
    Options.ReplaceSelection = False
    
    Selection.range.Style = "gmHylaFaxInfo"
    Selection.Style = ActiveDocument.Styles("gmHylaFaxInfo")
    Selection.TypeText Text:=" <TOCOMPANY:" + sCompany + "> "
    WordBasic.Insert " <TOFAXNUM:" + sFaxNum + "> "
    WordBasic.Insert " <TONAME:" + sRecipient + "> "
    WordBasic.Insert " <NOCOVER> " + Chr$(13) + Chr$(10)
    
    'Selection.Style = "Normal"
    
    Application.ScreenUpdating = True

End Sub
'
Private Sub PutHFInfo1(sAccNo, sFaxNum, sRecipient, sCompany)
'
'
'
    Application.ScreenUpdating = False
    
    Call ClearHFInfo
    
    Set MyStyle = ActiveDocument.Styles.Add(Name:="gmHylaFaxInfo", _
      Type:=wdStyleTypeCharacter)
    
    With MyStyle.Font
      .Size = 2
      .Bold = 0
      .Italic = 0
      .Underline = 0
      .Name = "Univers"
    End With

    Call Selection.EndKey(Unit:=wdStory)
    
    Options.ReplaceSelection = False
    
    Selection.range.Style = "gmHylaFaxInfo"
    Selection.Style = ActiveDocument.Styles("gmHylaFaxInfo")
    WordBasic.Insert " <TOCOMPANY:"
    WordBasic.InsertMergeField MergeField:=sCompany
    WordBasic.Insert "> "
    
    WordBasic.Insert " <TOFAXNUM:"
    WordBasic.InsertMergeField MergeField:=sFaxNum
    WordBasic.Insert "> "
    
    WordBasic.Insert " <TONAME:"
    WordBasic.InsertMergeField MergeField:=sRecipient
    WordBasic.Insert "> "
    
    WordBasic.Insert " <NOCOVER> " + Chr$(13) + Chr$(10)
    
    'Selection.Style = "Normal"
    
    Application.ScreenUpdating = True

End Sub
'
Private Sub ClearHFInfo()
'
' Removes the HylaFax codes
'
  Selection.HomeKey Unit:=wdStory
  
  On Error GoTo Done
  
  With Selection.Find
    .Style = "gmHylaFaxInfo"
    .MatchWholeWord = False
    .MatchCase = False
    .Forward = True
    .Format = True
    .Execute
  End With
    
  Selection.Delete
  
  ActiveDocument.Styles("gmHylaFaxInfo").Delete
  
  
Done:
  
End Sub