Originally posted at https://visio.getbb.ru/viewtopic.php?p=4885#p4885
Sub vsd_RepairError1()
dim fso ' определяем переменную fso объект файловой системы
dim fil ' определяем переменную fil файл
Dim nn as string ' определяем переменную nn - имя нового файла в формате vdx
Dim sn as string ' определяем переменную sn - полное имя редактируемого файла
Dim pth as string ' определяем переменную pth - путь к папке где лежит редактируемый файл
Dim fn as string ' определяем переменную fn - имя редактируемого файла
Dim doc As Document ' определяем переменную doc - собственно редактируемый файл
Set doc = ActiveDocument ' назначаем переменную doc - собственно редактируемый файл
pth = doc.Path ' назначаем переменную pth - путь к папке где лежит редактируемый файл
fn = doc.Name ' назначаем переменную fn - имя редактируемого файла
sn = pth & fn ' получаем переменную sn - полное имя редактируемого файла
nn = Replace(sn, ".vsd", ".vdx") ' получаем переменную nn - имя нового файла в формате vdx
doc.SaveAsEx nn, visSaveAsWS ' сохраняем редактируемый файл в формате vdx
doc.Close ' закрываем редактируемый файл
Documents.OpenEx nn, visOpenCopy ' открываем редактируемый файл заново
Set doc = ActiveDocument ' назначаем переменную doc - собственно почищенный файл
doc.SaveAs sn ' сохраняем полученный файл с первоначальным именем
doc.Close ' закрываем полученный файл
Set doc = Nothing ' освобождаем переменную doc
Set fso = CreateObject("Scripting.FileSystemObject") ' создаем объект файловой системы
Set fil = fso.GetFile(nn) ' получаем переменную fil файл с расширением vdx
fil.Delete ' удаляем файл с расширением vdx, ибо эти файлы очень много весят в 2-6 раз больше исходного
Set fil = Nothing ' освобождаем переменную fil
Set fso = Nothing ' освобождаем переменную fso
End Sub