在D盘建一个“Test”文件夹,并在Test文件夹下面放一个“结果”文件夹,把你要共享的文件拷贝到Test文件夹下,然后打开一个空白Excel文档执行下面的代码。
Sub xlsShare()
Dim Axls As String
Dim PsDoc As Workbook
Dim CurPath, Newpath As String
'On Error Resume Next
ChDrive "D"
ChDir "D:\test"
Axls = Dir("*.xls")
Application.ScreenUpdating = False
Do While Axls <> ""
CurPath = CurDir("D")
Set PsDoc = Workbooks.Open(Axls)
Workbooks(Axls).Activate
ChDrive "D"
ChDir "D:\test\结果"
With ActiveWorkbook
.KeepChangeHistory = True
.ChangeHistoryDuration = 30
End With
ActiveWorkbook.SaveAs Filename:=Axls, AccessMode:=xlShared
With ActiveWorkbook
.AutoUpdateFrequency = 5
.AutoUpdateSaveChanges = True
End With
ActiveWindow.Close SaveChanges:=False
ChDrive "D"
ChDir "D:\test"
Axls = Dir()
Loop
Application.ScreenUpdating = True
End Sub