Attribute VB_Name = "NewMacros"

Sub Macro1()
Attribute Macro1.VB_Description = "Macro recorded 27/10/00 by Squid"
Attribute Macro1.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro2"
'
' Macro1 Send Active Document to Pegasus as Attachment
' Macro created 27/10/00 by Ian Gibbons

    On Error Resume Next
    
    Dim PegasusFolderPath, strPath, strNewName, ShellRun, strOpen, fs
   
    PegasusFolderPath = "c:\pmail"
      
    strOpen = ActiveDocument.FullName
   
   If Err.Number > 0 Then
        MsgBox ("No Document to Send")
    Else
        ' check for WSendTo Program
        Set fs = CreateObject("Scripting.FileSystemObject")
        If fs.FileExists(PegasusFolderPath & "\wsendto.exe ") Then
        
            ' Save current document, then save document to a different file name.
            '   This is done because Pegasus cannot send a file when it is
            '   in use by another application (ie Word).
            
            strPath = ActiveDocument.FullName
            
			If InStr(strPath, ".doc") = 0 Then
			    ActiveDocument.SaveAs strPath
			    strPath = ActiveDocument.FullName
			Else
			    ActiveDocument.Save
			End If
			
            strNewName = Left(strPath, Len(strPath) - 4) & "-temp.doc"
            ActiveDocument.SaveAs strNewName
            ActiveDocument.Close

            ShellRun = PegasusFolderPath & "\wsendto.exe " & Chr(34) & strNewName & Chr(34)
                    
            ' Check if Windows Scripting Host Installed
            Dim oShell
            Set oShell = CreateObject("WScript.Shell")
            
            If Not IsObject(oShell) Then
                MsgBox "Windows Scripting Host not installed. " & vbCrLf & _
                   vbCrLf & "Cannot continue.", 44, "Send To Pegasus"
            Else
                ' Send document
                x = oShell.Run(ShellRun, 1, false)
                Set oShell = Nothing
            End If
            
            ' Change back to how we started
			Documents.Open FileName:=strPath
        Else
            MsgBox "Cannot Find The WSendTo Program. " & vbCrLf & _
                vbCrLf & "Please check it exists at the specified path.", 44, "Send To Pegasus"
        End If
        Set fs = Nothing
   End If
End Sub