去年在公司推动上线了JIRA作为IT服务平台，但JIRA对IE只兼容IE10以上版本，而公司电脑大部分都是XP，或WIN7+IE8，所以在JIRA上线时已经通过AD域给所有人安装了第三方浏览器，供JIRA访问用。但又出现的问题是，公司的OA都是老掉牙的Lotus，默认调用IE内核访问网站，造成的后果是JIRA发出的邮件通知无法用Lotus Notes访问，进一步造成无法回复消息，无法评论等问题。解决办法是把Notes的默认浏览器改为第三方的。
我希望通过一个小程序来自动修改Notes的配置，同时通过AD域将小程序分发到所有电脑执行。
和OA技术人员沟通后的回复是写不了这样的小程序。而通过发操作指引给用户自己修改，或手工一台台去配置NOTES、升级IE，将至少需要1个月才能完成。这个时间是我不能接受的。
通过google搜索一晚后，终于找到了解决方案，Notes支持COM接口，可以轻松通过VB访问。技术人员还是称无法实现，所以，只能自己动手了。核心代码如下：
Public Notes_Session As NotesSession Public Notes_Default_Password As String Public Notes_Default_Database As String '获取Notes数据库目录 Public Function getNotesDir(session As NotesSession) As String Dim path As String On Error GoTo ErrHandle If Not (session Is Nothing) Then path = session.GetEnvironmentString("Directory",True) If path <> "" Then path = path & "\names.nsf" End If getNotesDir = path Exit Function ErrHandle: Err.Raise -1,"getNotesDir","获取Notes数据库位置失败" & vbCrLf & path & vbCrLf & Err.Description End Function '获取IE版本 Public Function getIEVersion() As String Dim objReg As New cRegister ' Dim szVersion As String Dim svcVersion As String ' Dim aszTemp() As String ' On Error GoTo ErrHandle '优先取升级后的版本 szVersion = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Internet Explorer","svcVersion","") '若未升级则直接取版本 If szVersion = "" Then szVersion = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE,"Version","6.0") aszTemp = Split(szVersion,".") If UBound(aszTemp) >= 1 Then getIEVersion = "IE" & aszTemp(0) Else getIEVersion = "IE6" End If Exit Function ErrHandle: Err.Raise -1,"getIEVersion","获取IE版本失败" & Err.Description End Function Public Function getOSVersion() As String End Function '获取机器上的第三方浏览器，按优先顺序读取。 Public Function getWebbrowser() As String Dim path As String,sztemp As String Dim objReg As New cRegister ' On Error GoTo errorhandle '1、360chrome sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER,"SOFTWARE\360Chrome\Chrome","last_install_path","") path = Replace(sztemp & "\360Chrome\Chrome\Application\360chrome.exe","\\","\",vbTextCompare) If sztemp = "" Or Dir(sztemp) = "" Then sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360chrome.exe","","") path = sztemp End If If sztemp = "" Or Dir(sztemp) = "" Then sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER,"") path = sztemp End If '2、360se If sztemp = "" Or Dir(sztemp) = "" Then sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER,"SOFTWARE\360\360se8\chrome","") path = Replace(sztemp & "\360se8\Application\360se.exe",vbTextCompare) End If If sztemp = "" Or Dir(sztemp) = "" Then sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER,"SOFTWARE\360\360se7\chrome","") path = Replace(sztemp & "\360se7\Application\360se.exe","SOFTWARE\360\360se6\chrome","") path = Replace(sztemp & "\360se6\Application\360se.exe","SOFTWARE\360\360se5\chrome","") path = Replace(sztemp & "\360se5\Application\360se.exe","SOFTWARE\360\360se4\chrome","") path = Replace(sztemp & "\360se4\Application\360se.exe",vbTextCompare) End If If sztemp = "" Or Dir(sztemp) = "" Then sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se4.exe","") path = sztemp End If If sztemp = "" Or Dir(sztemp) = "" Then sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se5.exe","SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se6.exe","SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se7.exe","SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se8.exe","SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\360se.exe","") path = sztemp End If '3、QQ If sztemp = "" Or Dir(sztemp) = "" Then sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER,"SOFTWARE\Tencent\QQBrowser","") path = Replace(sztemp & "\QQBrowser.exe","SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\QQBrowser.exe","") path = sztemp End If '4、搜狗 If sztemp = "" Or Dir(sztemp) = "" Then sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER,"SOFTWARE\SogouExplorer","") path = Replace(sztemp & "\SogouExplorer.exe","SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\SogouExplorer.exe","") path = sztemp End If '5、UC If sztemp = "" Or Dir(sztemp) = "" Then sztemp = objReg.GetRegistryValue(HKEY_CURRENT_USER,"SOFTWARE\UCBrowser\","L:\Program Files (x86)\UCBrowser\Application","") path = Replace(sztemp & "\UCBrowser.exe","SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\UCBrowser.exe","") path = sztemp End If '6、百度 If sztemp = "" Or Dir(sztemp) = "" Then sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\baidubrowser.exe","") path = sztemp End If '7、Chrome If sztemp = "" Or Dir(sztemp) = "" Then sztemp = objReg.GetRegistryValue(HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\chrome.exe","") path = sztemp End If '8、Firefox If sztemp = "" Or Dir(sztemp) = "" Then sztemp = "%PROGRAMFILES%\Mozilla Firefox\firefox.exe" path = sztemp End If path = Replace(path,vbTextCompare) If Dir(sztemp) = "" Then path = "" getWebbrowser = path Exit Function errorhandle: Err.Raise -1,"getWebbrowser","获取浏览器路径失败" & Err.Description End Function '设置浏览器 Public Function setCurrentBrowser(session As NotesSession,path As String) As String Dim NotesDatabase As NotesDatabase Dim NotesView As NotesView Dim doc As NotesDocument Dim item As NotesItem On Error GoTo errorhandle Set NotesDatabase = session.GetDatabase("",getNotesDir(session)) If NotesDatabase.IsOpen = False Then NotesDatabase.Open Set NotesView = NotesDatabase.GetView("($Locations)") Set doc = NotesView.GetFirstDocument() While Not (doc Is Nothing) 'If doc.ColumnValues(1) = "联机" Then GoTo start doc.ReplaceItemValue "WebRetriever","99" doc.ReplaceItemValue "WebRetrieverPath",path doc.ComputeWithForm False,False doc.Save True,True Set doc = NotesView.GetNextDocument(doc) Wend start: Set doc = Nothing Set NotesView = Nothing Set NotesDatabase = Nothing Exit Function errorhandle: Err.Raise -1,"setCurrentBrowser","设置当前浏览器配置失败" & Err.Description End Function '获取Notes Session Public Function getSession() As NotesSession Dim session As New NotesSession Dim password As String Dim errorcount As Long On Error Resume Next session.Initialize (Notes_Default_Password) If Err.Number <> 0 Then start1: Err.Clear password = LoginOn() session.Initialize password If Err.Number <> 0 And errorcount < 3 Then errorcount = errorcount + 1 GoTo start1 End If End If On Error GoTo errorhandle If session Is Nothing Then Err.Raise -1,"getSession","获取Session失败" Set getSession = session Exit Function errorhandle: Err.Raise -1,"获取Session失败" & Err.Description End Function '写日志文件 Public Sub WriteLog(Message As String) Dim F As Integer On Error Resume Next F = FreeFile Message = Message & vbTab & ">" & Now() Open App.path & "\ErrorLog\" & Format(Now,"YYYYMMDD") & "_log.txt" For Append As #F Print #F,Message Close #F End Sub '登录Notes Public Function LoginOn() As String Dim frm As New frmmain frm.Show 1 LoginOn = frm.password 'Unload frm Set frm = Nothing End Function Public Sub Main() Dim BrowserPath As String 'On Error GoTo errorhandle Notes_Default_Password = "hucais" Notes_Default_Database = "names.nsf" Set Notes_Session = getSession() 'IE5,6,7,8,9则修改 If "IE5|IE6|IE7|IE8|IE9|IE10|IE11" Like "*" & getIEVersion() & "*" Then ' If getCurrentBrowser(Notes_Session) <> "99" Then BrowserPath = getWebbrowser() WriteLog getIEVersion() & ">>" & BrowserPath If BrowserPath <> "" Then setCurrentBrowser Notes_Session,BrowserPath ' End If End If Exit Sub errorhandle: MsgBox Err.Description WriteLog Err.Description & ">>" & Err.source End Sub代码中的frmmain为密码输入窗口，cRegister为很早以前的注册表类，网上容易找这类东西，不再贴出，
最费时的在于理清楚Notes的database,view,document的关系，并且摸清楚nsf数据库的结构，有哪些view,有哪些document,document的item中有些什么内容，通过对比修改配置前后数据，找出了默认浏览器的配置项。
找出names.nsf存储位置，各种浏览器的存储位置也花了不少时间，注册表翻了个遍，把所有能藏身的地方都找了，最终能完美支持各种常用的浏览器。
原文链接：https://www.f2er.com/vb/256923.html