html在线浏览本地word,本地html文件中的文档链接直接打开本地word文件！！！

新建一个excel文档，将下面代码放进去运行下，在excel表单里生成两栏，一栏是目录，一栏是文件名称。里面都有超链接，点击即可打开目录或文档。请依据自己需要进行修改。

Sub getmdr()

Dim objShell, objFolder, lj

On Error Resume Next

Set objShell = CreateObject("Shell.Application")

Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)

If Not objFolder Is Nothing Then lj = objFolder.self.Path

Set objFolder = Nothing

Set objShell = Nothing

Application.ScreenUpdating = False

With Sheet1

.UsedRange.Clear

With .Cells(1, 1)

.Value = "文件目录"

.Font.Name = "微软雅黑"

.Font.Italic = True

.Font.Bold = True

.Font.Size = 15

End With

With .Cells(1, 2)

.Value = "文件名称"

.Font.Name = "微软雅黑"

.Font.Italic = True

.Font.Bold = True

.Font.Size = 15

End With

End With

Getfd (lj) 'ThisWorkbook.Path是当前代码文件所在路径，路径名可以根据需求修改

Application.ScreenUpdating = True

End Sub

Sub Getfd(ByVal pth)

Set Fso = CreateObject("scripting.filesystemobject")

Set ff = Fso.getfolder(pth)

For Each F In ff.Files

Rem 具体提取哪类文件，还是需要根据文件扩展名进行处理

s = Sheet1.Range("a65536").End(xlUp).Row

'  If InStr(Split(F.Name, ".")(UBound(Split(F.Name, "."))), "xl") > 0 And InStr(F.Name, "~$") = 0 Then   '提取excel文件

If F.Name <> ThisWorkbook.Name Then

With Sheet1

.Cells(s + 1, 1) = ff.Path

.Cells(s + 1, 2) = F.Name

.Cells(s + 1, 1).Hyperlinks.Delete

.Cells(s + 1, 2).Hyperlinks.Delete

.Hyperlinks.Add anchor:=.Cells(s + 1, 1), Address:=.Cells(s + 1, 1)

.Hyperlinks.Add anchor:=.Cells(s + 1, 2), Address:=F.Path

End With

End If

' End If

Next F

For Each fd In ff.subfolders

Getfd (fd)

Next fd

Sheet1.Range("a1").CurrentRegion.EntireColumn.AutoFit

Sheet1.Range("a1").CurrentRegion.RowHeight = 25

Sheet1.Range("a1").RowHeight = 30

Sheet1.Range("a1").CurrentRegion.Borders.LineStyle = xlContinuous   ''设置单元格边框

End Sub