Sub NAUMakeandSendHTM()
    ' This macro FTPs a copy of a file to /~cvb/hdoc/ at nau.balch.org and /cvb23/hdoc oak.ucc.nau.edu
    '
    ' Written by Charles Balch.  charlie@balch.org
    ' Public Domain 1998-2011  Copyright. All rights reserved.
    '
    DoEvents
    sFileName = InputBox("Use Filename ", "Make & Send", ActiveSheet.Name & ".htm")
    If Len(sFileName) < 2 Then End
    If InStr(1, sFileName, "Content", vbTextCompare) Then Call NAUFTP("bp_" & sFileName) 'Create boilerplate as needed
    Call NAUFTP(sFileName)
End Sub

Sub NAUFTP(sFileName)
    Dim sAction, sAppPath, sBalchPath, sFilePath, sLocalFile, sNAUApp, sPath As String
    sAppPath = "X:\DropBox\NAU CVB Web\hdoc\winscp.exe"
    sFilePath = "X:\DropBox\NAU CVB Web\hdoc\"
    sBalchApp = sAppPath & " BalchNAU /upload "
    sNAUApp = sAppPath & " NAUOak /upload "
    
    'Create document
    sLocalFile = sFilePath & sFileName
    Names.Add Name:="FastHTMLExport", RefersTo:=Selection
    Call RangeToHTM("FastHTMLExport", sLocalFile, "NAU")
    
    'Send to NAU Balch.org file
    DoEvents
    sAction = sBalchApp & Chr(34) & sLocalFile & Chr(34) & " /defaults"
    Shell (sAction), vbNormalFocus
    
    'Send to NAU oak.ucc.nau.edu
    DoEvents
    sAction = sNAUApp & Chr(34) & sLocalFile & Chr(34) & " /defaults"
    Shell (sAction), vbNormalFocus
    
    'Put NAU Path in Clipboard
    subPutInClipboard "http://oak.ucc.nau.edu/cvb23/hdoc/" & sFileName
    'subPutInClipboard "http://nau.balch.org/cvb23/hdoc/" & sFileName
    Beep
End Sub