Путь сохранения с учетом изменения имени съемного носителя

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Путь сохранения с учетом изменения имени съемного носителя (Макросы/Sub)

Сергей13

Дата: Среда, 20.10.2021, 01:24 | Сообщение № 1

Группа: Проверенные

Ранг: Обитатель

Сообщений: 344

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Здравствуйте!
Ребята сохраняемый файл который находится на съемном носителе D, сохраняю в другую папку на тот-же носитель D.
[vba]

Код

ActiveWorkbook.SaveAs Filename:="D\Папка\Подпапка\тест.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

[/vba]
Дело в том что если использовать носитель на другом компьютере то изменяется его имя (например на E) и код выдает ошибку.
Как прописать путь сохранения с учетом изменения имени съемного носителя?

Ответить

Nic70y

Дата: Среда, 20.10.2021, 07:59 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 8759

Репутация: 2273 ±

Замечаний: 0% ±

Excel 2010

[vba]

Код

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\тест.xlsm"

[/vba]так попробуйте,
вдруг правильно

ЮMoney 41001841029809

Ответить

R_Dmitry

Дата: Среда, 20.10.2021, 10:52 | Сообщение № 3

Группа: Друзья

Ранг: Участник

Сообщений: 74

Репутация: 34 ±

Замечаний: 0% ±

2010

[vba]

Код

Function GetRemovableDrivePath(sFolderPath)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Drives = FSO.Drives
For Each dr In Drives
If dr.DriveType = 1 Then
    sPath = FSO.BuildPath(dr.Path, sFolderPath)
    If FSO.FolderExists(sPath) Then
        GetRemovableDrivePath = sPath
        Exit For
    End If
End If
Next
End Function

Sub test()
sFolderName = GetRemovableDrivePath("\Program Files\New Folder")
If Not IsEmpty(sFolderName) Then MsgBox "Ваш каталог : " & sFolderName Else MsgBox "Ваш каталог не найден"
End Sub

[/vba]

{Skype : RDG_Dmitry} Если программа тебе понятна,значит она уже устарела

Сообщение отредактировал R_Dmitry - Среда, 20.10.2021, 10:54

Ответить

boa

Дата: Среда, 20.10.2021, 12:58 | Сообщение № 4

Группа: Друзья

Ранг: Ветеран

Сообщений: 550

Репутация: 167 ±

Замечаний: 0% ±

365

Здравствуйте, Сергей13,
[vba]

Код

Dim Disk$: Disk = VBA.Left$(ActiveWorkbook.Path, 1)
ActiveWorkbook.SaveAs Filename:=Disk & ":\Папка\Подпапка\тест.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

[/vba]

Сообщение отредактировал boa - Среда, 20.10.2021, 13:00

Ответить

bmv98rus

Дата: Среда, 20.10.2021, 21:25 | Сообщение № 5

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4107

Репутация: 768 ±

Замечаний: 0% ±

Excel 2013/2016

[vba]

Код

ActiveWorkbook.SaveAs Filename:=CreateObject("Scripting.FileSystemObject").GetDriveName(ThisWorkbook.FullName) & ":\Папка\Подпапка\тест.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

[/vba]

~~Замечательный~~ Временно просто медведь ~~, процентов на 20~~.

Ответить

Страница 1 из 1
1