[求助]这段保存文件的代码速度奇慢

jsyzzym

我在日常工作中为了方便文档管理，写了一段WORD VBA帮助同事自动存储WORD文档到临时文件中，并加上页眉为文档保存的路径，但速度奇慢，比同事自己保存还要慢3倍。请各位帮忙看一下我的VBA中有什么问题，谢谢了。

说明一下：Z盘是映射的一台文档共享服务PC的一个共享文件夹，通过WORD正常保存文档时速度正常，但使用这个宏时就比较慢，主要就是在查找未被使用的文件名时速度奇慢。

Sub 保存到临时目录()
Dim Openfilename$, Openfileyear$, Openfullpath$, i, IDfile$, m

'临时文件存放路径
Openfullpath = "Z:\" & Trim(Str(Year(Date))) & "\TEMP\"
'生成当前年度的ID文件名
IDfile = "Z:\★★★共享&常用&模板★★★\" & "LastID" & Trim(Str(Year(Date))) & ".TXT"

Set fs = Application.FileSearch
With fs
    .LookIn = "Z:\★★★共享&常用&模板★★★\"
    .filename = "LastID" & Trim(Str(Year(Date))) & ".TXT"
    If .Execute = 0 Then
       MsgBox "没有找到今年的临时文件ID文件！准备生成！"
       Open IDfile For Output As #1
       m = 1
       Print #1, Trim(Str(m))
       Close #1
       MsgBox "已经生成完毕！"
    End If
End With

'取上次写入的值
Open IDfile For Input As #1
Input #1, i
Close #1

'生成临时文件名
Openfilename = "ls" & Trim(Str(i)) & ".DOC"

stat.Show 0
stat.Caption = "已查找：" & Trim(Str(i)) & "个文件。"

With fs
    .LookIn = Openfullpath
    .filename = Openfilename

    Do
       If .Execute() = 0 Then
          stat.Hide
          MsgBox "找到了" & Openfilename & "未被使用！"

          '记录这次查找的最后序列号
          Open IDfile For Output As #1
          Print #1, Trim(Str(i + 1))
          Close #1    ' 关闭文件。
        
          Exit Do
       Else
          i = i + 1
          stat.Caption = "已查找：" & Trim(Str(i)) & "个文件。"
          Openfilename = "ls" & Trim(Str(i)) & ".DOC"
          '重新设置查找文件名，重新查找一次
          .filename = Openfilename
       End If
    Loop
End With
ActiveDocument.SaveAs filename:=Openfullpath & Openfilename
'插入路径
Call 插入路径
End Sub

守柔

参考一下这个链接。

直接使用DIR检测是否存在指定文件名。

jsyzzym

呵呵，十分感谢你提供的思路，谢谢！我自己去查一下VBA的帮助，看看DIR命令，再次感谢。

jsyzzym

再次感谢守柔版主，问题完美解决，速度奇快