R
RB Smissaert
Trying to figure out a simple way how to load a local .htm file (actually
this is a folder with loads
of different .htm files, .gif files and some other files) with a
HelpContextID. This is actually a Webhelp
that is somewhere on a server, but you can also have these files locally
(with the same directory structure
as the Webhelp) and load them.
I can load the Webhelp with a HelpContextID easily via
ActiveWorkbook.FollowHyperlink and I can also
load the .htm files without the HelpContextID via this code:
Option Explicit
Private Declare Function FindExecutable Lib "shell32" _
Alias "FindExecutableA" _
(ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal sResult As String) As Long
Private Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" _
(ByVal nSize As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenW" (ByVal lpString As Long)
As Long
Private Const MAX_PATH As Long = 260
Private Const ERROR_FILE_NO_ASSOCIATION As Long = 31
Private Const ERROR_FILE_NOT_FOUND As Long = 2
Private Const ERROR_PATH_NOT_FOUND As Long = 3
Private Const ERROR_FILE_SUCCESS As Long = 32 'my constant
Private Const ERROR_BAD_FORMAT As Long = 11
Function bFileExists(strFile As String) As Boolean
bFileExists = (Len(Dir(strFile)) > 0)
End Function
Function TrimNull(startstr As String) As String
TrimNull = Left$(startstr, lstrlen(StrPtr(startstr)))
End Function
Sub ShowHelp()
Dim strLocalDrive As String
Dim strHTMLHelpPath As String
Dim strBrowserPath As String
Dim lReturnFlag As Long
strLocalDrive = Left$(Application.Path, 1)
strHTMLHelpPath = strLocalDrive &
":\RBSSynergyReporting\Help\WebHelp\RBSSynergy.htm"
If bFileExists(strHTMLHelpPath) Then
strBrowserPath = GetBrowserName(lReturnFlag)
Select Case lReturnFlag
Case Is >= ERROR_FILE_SUCCESS
Shell strBrowserPath & " " & _
strHTMLHelpPath, _
vbMaximizedFocus
Exit Sub
'will need some suitable error messages here
Case ERROR_FILE_NO_ASSOCIATION
Case ERROR_FILE_NOT_FOUND
Case ERROR_PATH_NOT_FOUND
Case ERROR_BAD_FORMAT
Case Else
End Select
Else
MsgBox "No help file present", , "launch help"
End If
End Sub
Function GetBrowserName(dwFlagReturned As Long) As String
Dim hFile As Long
Dim sResult As String
Dim sTempFolder As String
'get the user's temp folder
sTempFolder = GetTempDir()
'create a dummy html file in the temp dir
hFile = FreeFile
Open sTempFolder & "dummy.html" For Output As #hFile
Close #hFile
'get the file path & name associated with the file
sResult = Space$(MAX_PATH)
dwFlagReturned = FindExecutable("dummy.html", sTempFolder, sResult)
'clean up
Kill sTempFolder & "dummy.html"
'return result
GetBrowserName = TrimNull(sResult)
End Function
Public Function GetTempDir() As String
Dim nSize As Long
Dim tmp As String
tmp = Space$(MAX_PATH)
nSize = Len(tmp)
Call GetTempPath(nSize, tmp)
GetTempDir = TrimNull(tmp)
End Function
Ideally I would just like to alter this bit of code:
Shell strBrowserPath & " " & _
strHTMLHelpPath, _
vbMaximizedFocus
And somehow add the HelpContextID
Thanks for any advice.
RBS
this is a folder with loads
of different .htm files, .gif files and some other files) with a
HelpContextID. This is actually a Webhelp
that is somewhere on a server, but you can also have these files locally
(with the same directory structure
as the Webhelp) and load them.
I can load the Webhelp with a HelpContextID easily via
ActiveWorkbook.FollowHyperlink and I can also
load the .htm files without the HelpContextID via this code:
Option Explicit
Private Declare Function FindExecutable Lib "shell32" _
Alias "FindExecutableA" _
(ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal sResult As String) As Long
Private Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" _
(ByVal nSize As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenW" (ByVal lpString As Long)
As Long
Private Const MAX_PATH As Long = 260
Private Const ERROR_FILE_NO_ASSOCIATION As Long = 31
Private Const ERROR_FILE_NOT_FOUND As Long = 2
Private Const ERROR_PATH_NOT_FOUND As Long = 3
Private Const ERROR_FILE_SUCCESS As Long = 32 'my constant
Private Const ERROR_BAD_FORMAT As Long = 11
Function bFileExists(strFile As String) As Boolean
bFileExists = (Len(Dir(strFile)) > 0)
End Function
Function TrimNull(startstr As String) As String
TrimNull = Left$(startstr, lstrlen(StrPtr(startstr)))
End Function
Sub ShowHelp()
Dim strLocalDrive As String
Dim strHTMLHelpPath As String
Dim strBrowserPath As String
Dim lReturnFlag As Long
strLocalDrive = Left$(Application.Path, 1)
strHTMLHelpPath = strLocalDrive &
":\RBSSynergyReporting\Help\WebHelp\RBSSynergy.htm"
If bFileExists(strHTMLHelpPath) Then
strBrowserPath = GetBrowserName(lReturnFlag)
Select Case lReturnFlag
Case Is >= ERROR_FILE_SUCCESS
Shell strBrowserPath & " " & _
strHTMLHelpPath, _
vbMaximizedFocus
Exit Sub
'will need some suitable error messages here
Case ERROR_FILE_NO_ASSOCIATION
Case ERROR_FILE_NOT_FOUND
Case ERROR_PATH_NOT_FOUND
Case ERROR_BAD_FORMAT
Case Else
End Select
Else
MsgBox "No help file present", , "launch help"
End If
End Sub
Function GetBrowserName(dwFlagReturned As Long) As String
Dim hFile As Long
Dim sResult As String
Dim sTempFolder As String
'get the user's temp folder
sTempFolder = GetTempDir()
'create a dummy html file in the temp dir
hFile = FreeFile
Open sTempFolder & "dummy.html" For Output As #hFile
Close #hFile
'get the file path & name associated with the file
sResult = Space$(MAX_PATH)
dwFlagReturned = FindExecutable("dummy.html", sTempFolder, sResult)
'clean up
Kill sTempFolder & "dummy.html"
'return result
GetBrowserName = TrimNull(sResult)
End Function
Public Function GetTempDir() As String
Dim nSize As Long
Dim tmp As String
tmp = Space$(MAX_PATH)
nSize = Len(tmp)
Call GetTempPath(nSize, tmp)
GetTempDir = TrimNull(tmp)
End Function
Ideally I would just like to alter this bit of code:
Shell strBrowserPath & " " & _
strHTMLHelpPath, _
vbMaximizedFocus
And somehow add the HelpContextID
Thanks for any advice.
RBS