在EXCEL表格中成批管理WORD文档

weiguoyin868

现在做人力资源工作很不容易，很多人觉得工作量较大，特别是在进行大量的文件处理时，更是感到力不从心你，比如在招聘工作中要完成大量的应聘人员简历的筛选；绩效考核时，要给领导整理很多员工的总结；在定岗定员时要编写众多的岗位说明书。怎样快速整理查看呢？本人就是通过工作实际经验，特别是近期整理员工的岗位说明书的工作，因为多个部门的岗位说明书，每个部门有很多岗位，需要逐一审核修改，还要写出修改意见。原来的方法是，每个部门建一个文件夹，下面放该部门的岗位说明书，用WORD逐一打开修改，又不许用批注，文件修改多时，记不清那些修改了，很麻烦，另一方面，还要求用EXCEL汇总，所有岗位名称都要录入到EXCEL表中，或通过粘贴过来，非常耗时。于是VBA编写了一个实用程序。该程序能实现以下功能，一是能自动将所选目录下的文件名导入到EXCEL表中，同时也将目录名导进来；另一方面，当需要查看文件时，直接双击单元格中的文件名，就能自动打开该WORD文件。
程序有两段代码：导入文件按钮代码：
Private Sub CommandButton1_Click()
          Dim FileName     As Variant
          Dim ee As Variant
          Dim ii As Integer

          MaxRowx = Cells(2, 2).CurrentRegion.Rows.Count
          ii = MaxRowx
         
          FileName = Application.GetOpenFilename(FileFilter:="(*),*", Title:="请选择文件，'Ctrl+A'全选", MultiSelect:=True)
          If Not IsArray(FileName) Then
                MsgBox "你未选择文件..."
          Else
                For Each nx In FileName
               
                        ee = Split(nx, ".doc")
                        
                        ff = Split(ee(0), "\")
                        
                        fdf = UBound(ff)
                        Cells(ii, 1) = ii - 1
                        Cells(ii, 2) = ff(fdf)
                        Cells(ii, 3) = ff(fdf - 1)
                        
                        'MsgBox ff(fdf - 1)
                        'MsgBox ff(fdf)                        
                        ii = ii + 1
                Next
          End If
End Sub
查看WORD文件代码：
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim wdApp

path_ = ThisWorkbook.Path
On Error Resume Next

dirr = Dir(path_ & "\" & Cells(Target.Row, Target.Column + 1) & "\" & Cells(Target.Row, Target.Column) & ".doc")

If (dirr = "") Then
MsgBox "文件不存在！"
Else
Set wdApp = CreateObject("word.application")

wdApp.Visible = True
ttt = wdApp.Documents.Open(path_ & "\" & Cells(Target.Row, Target.Column + 1) & "\" & Cells(Target.Row, Target.Column) & ".doc")
End If

'MsgBox Cells(Target.Row, Target.Column)

Set wdApp = Nothing

wdApp.Close

End Sub
代码写的仓促，尚未规范，效果没问题，希望对大家有帮助。

下面是程序运行效果图和该程序附件：

[ 本帖最后由 weiguoyin868 于 2010-4-26 22:17 编辑 ]

wangtx218

太实用了！谢谢你！

chenyg65

非常实用，谢谢分享。

沙沙505

非常好，文件多了如果不妥善管理，会整死自己。向楼主学习

xzm577

好是好，就是如是导入错了的话不方便删除。。。还有我这里怎么不能在单元格里直接打开文件呢》？

jeffno1

lyxgjys

双击不能打开doc文件啊！

yafu888

如果还可以直接修改文件名，直接可以移动文件到别的文件夹，功能再多些就更好了~~
老师们努力，一定行的

xws1985

经典！！！！！！！！！！！1

ntlyp

是不是不能直接双击打开WORD文件？