Здравствуйте! Прошу помочь в решении возникшей проблемы. Рядом с файлом лежит папка «Бланки», в ней находятся папки с файлами (в прилагаемых макросах – «Старое имя папки» и «Файл с данными»). Необходимо на основании данных из файлов сформировать имена (Link) и присвоить их родительским папкам («Старое имя папки» заменить на Link). Первый макрос, где я конкретно прописываю FilePath, работает. Во втором макросе я пытаюсь взять путь к файлу из диалога GetOpenFilename, VBA на строке переименования выдает ошибку: Run-time error ‘75’: Path/file access error. Подскажите, пожалуйста, что делаю не так?
И еще один вопрос. Если во втором макросе переменной FilePath присвоить тип String, то на строке If FilePath = False Then появляется ошибка о несоответствии типа переменной, а тип Variant пропускает. Как правильно вычислить, что в диалоговом окне файл не был выбран?
Макрос, который работает:
Макрос, который не работает:
И еще один вопрос. Если во втором макросе переменной FilePath присвоить тип String, то на строке If FilePath = False Then появляется ошибка о несоответствии типа переменной, а тип Variant пропускает. Как правильно вычислить, что в диалоговом окне файл не был выбран?
Макрос, который работает:
| Код |
|---|
Sub Работает()
Dim FilePath As String
Dim FolderPath As String
Dim FolderName As String
Dim iExtension As String
Dim link As String ' новое имя папки
Dim check As Boolean
FilePath = "C:\Users\Павел\Desktop\БЗ\Бланки\Старое имя папки\Файл с данными.doc"
iExtension = CreateObject("Scripting.FileSystemObject").GetExtensionName(FilePath) ' Расширение файла
FolderPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(FilePath) ' Имя родительской папки
FolderName = Replace(FolderPath, ThisWorkbook.Path & "\" & "Бланки" & "\", "") ' Имя папки для TextToDisplay гиперссылки
link = "Новое имя папки"
Name FolderPath As ThisWorkbook.Path & "\Бланки\" & link
End Sub
|
Макрос, который не работает:
| Код |
|---|
Sub Не_работает()
Dim FilePath As Variant
Dim FolderPath As String
Dim FolderName As String
Dim iExtension As String
Dim WordApp As Object, CopyArea As Variant
Dim link As String ' новое имя папки
Dim check As Boolean
ChDir ThisWorkbook.Path & "\" & "Бланки" & "\" ' Путь к папкам с бланками-заказами
FilePath = Application.GetOpenFilename("all Files (*.*), *.*", Title:="Выберите файл") ' Диалог выбора файла
If FilePath = False Then 'Если файл не выбран, то сбрасывается check, выводится сообщение и выход
check = False
MsgBox "Файл не выбран!", 48, "ВНИМАНИЕ!"
Exit Sub
End If
iExtension = CreateObject("Scripting.FileSystemObject").GetExtensionName(FilePath) ' Расширение файла
FolderPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(FilePath) ' путь к родительской папке
FolderName = Replace(FolderPath, ThisWorkbook.Path & "\" & "Бланки" & "\", "") ' Имя папки для TextToDisplay гиперссылки
link = "Новое имя папки" ' в данном макросе равно FolderName
Name FolderPath As ThisWorkbook.Path & "\Бланки\" & link
End Sub
|
Пока нет времени разбираться, может позже, если никто ничего не придумает.
