BhBp_SaveAsCopy

Hello, for experimental purpose I use code below to create 3000 - 300000 files. This process is to slow and it's seems, that PC hangs.
Please, help me to improve this code to work faster.

Sub BhBp_SaveAsCopy()
For X = 1 To 3000
ActiveDocument.SaveAsCopy ActiveDocument.FilePath & "DOCUMENT_" & String(10 - Len(X), "0") & X & ".cdr"
Next
End Sub

Greetings!