Save operation can not be completed due to a file permission error

See more:

VBA

Sub 宏1()

Dim docNew As Document
Dim k As Integer
Dim ks As String
k = 0
Set docNew = Documents.Add
jk0 = "D:\gstk_doc\" 'doc文档路径
s = Dir(jk0, vbDirectory)
Do While s <> "" ' 开始循环。
If s <> "." And s <> ".." Then
Set doc = Documents.Open(jk0 & s, ReadOnly:=True, Visible:=True) '打开 doc文件
doc.Activate

For Each i In ActiveDocument.Paragraphs
If Left(Trim(i.Range.Text), 2) = "``" Then
k = k + 1
If k < 10 Then
ks = "t000" & Trim(Str(k))
Else
If k < 100 Then
ks = "t00" & Trim(Str(k))
Else
If k < 1000 Then
ks = "t0" & Trim(Str(k))
Else
ks = "t" & Trim(Str(k))
End If
End If
End If
i.Range.Copy
docNew.Close SaveChanges:=wdSaveChanges
Set docNew = Documents.Add(Visible:=False)
With docNew
.Content.Paragraphs.Last.Range.Select
' Selection.Paste '这是被选中的文档被粘贴覆盖,
.SaveAs FileName:="D:\gstk_doc\gstk_dt\" & ks & Mid(Trim(i.Range.Text), 3, 15) & ".doc"
End With
' docNew.Close
Else
i.Range.Copy
With docNew
.Content.Paragraphs.Last.Range.Select
Selection.Paste '这是被选中的文档被粘贴覆盖,
End With
End If
Next i
doc.Close
End If
s = Dir ' 查找下一个目录。
Loop

End Sub