Как скопировать открытый файл vba скриптом?

Question

[adam18644]

Блин ребят можете говорить сколько угодно, гугл в помощь читай документацию. но увы я все что нашел, все вариации перепробовал
в данном случае выдает ошибку 424
для примера вставил путь темп понимаю что всего скорее он неверно указан, но тест я проводил на ошибка точно такаяже

(ThisWorkbook.Path & "\doc.docm")
А вот собственно сам код

Sub WorkBook_open()

Set fso = CreateObject("Scripting.FileSystemObject")

Set File = fso.GetFile(ThisWorkbook.Path & "\doc.docm")
Set File = fso.Copy("%Temp%\d6c.docm")
End Sub

буду весьма благодарен если поможете в решении вопроса, а не начнете ссыпать оценночным мнением

Comments

[Akina]

adam18644 Это Вы удалили ту копию вопроса, в которой шло обсуждение?

[adam18644]

Akina, я хотел создать новую что бы все увидели, вообщем я там кучу вариантов перебрал. есть те которые работаеют, но они не кантактируют с возможностью выбора использования копирования открытого файла

[adam18644]

Sub FileCopy_Example2()

Dim SourcePath As String
Dim DestinationPath As String

SourcePath = "C:\Users\admin\Desktop\~$doc.docm"
DestinationPath = "C:\Users\admin\Documents\doc.docm"

FileCopy SourcePath, DestinationPath

End Sub

вот этот вариант получился
ну я не знаю как его сделать под открытый файл

[adam18644]

Sub test()
 
 Set FSO = CreateObject("Scripting.FileSystemObject")

FSO.CopyFile "ThisWorkbook.Path & "\doc.docm", "C:\users\admin\documents", 0
End Sub

или как ту тсправиться

[adam18644]

Akina,

Sub Manip_Files()
Dim sWrb
Dim SourcePath As String
Dim DestinationPath As String
sWrb = (ThisWorkbook.Path & "\doc.docm")

SourcePath = "sWrb"
DestinationPath = "C:\Users\admin\Documents\doc.docm"

FileCopy SourcePath, DestinationPath

End Sub

еще такой вариант у меня был
ВСЁ
КОНЕЦ
...
все мои варианты отнюдь закончились, бля выручай. спасешь молодые мозги от вытикания, я уже не знаю в какую сторону капать.

[adam18644]

Akina, thisislink
я так понял ответ кроется в недрах этого поста. но я так и не смог размозговать

Answer 1

[Akina]

Вот нафига было удалять предыдущую версию вопроса?

Ладно, повторю. У FileSystemObject нет метода Copy, он есть у объектов Folder и File. Следовательно,

Set File = fso.GetFile(ThisWorkbook.Path & "\doc.docm")
Set File = fso File.Copy("%Temp%\d6c.docm")

PS. Что такое "открытый файл", где, кем и вообще почему он открытый - так и не понял.

Comments

[adam18644]

rPman @rPman
зачем ты создаешь себе проблему, по умолчанию обычно файлы открываются с режимом блокировки на чтение запись, нормальные языки программирования позволяют управлять этими флагами

сначала закрой файл, потом копируй
Написано час назад
НравитсяОтветить
 adam18644 @adam18644 Автор вопроса
rPman, незачем. это офис он создает дубликат и только его блокирует. поэтому должно сработать, хоть я и не художник, но я так вижу
так а если я пропишу закрытие файла он по факту не закроется?
Написано час назад
НравитсяОтветить
 Akina @Akina
Бред сивой кобылы, а не код.

FileSystemObject не имеет метода Copy - такой метод есть у объектов File и Folder. Так что просто надо следжить за руками...
Написано час назад
НравитсяОтветить
 adam18644 @adam18644 Автор вопроса
rPman, хотя ты прав
Sub FileCopy_Example2()

Dim SourcePath As String
Dim DestinationPath As String

SourcePath = "C:\Users\admin\Desktop\doc.docm"
DestinationPath = "C:\Users\admin\Documents\doc.docm"

FileCopy SourcePath, DestinationPath

End Sub

c этим кодом уже точно беда пишет ошибка доступаа
ну этот вариант мне не подходит, так как как ты уже понял мне нужно скопировать файл где бы он не находился. если тебе не сложно мог бы ты приложить свою вариацию данного кода
Написано час назад
НравитсяОтветить
 adam18644 @adam18644 Автор вопроса
adam18644, так я все таки в чем то был прав при открытии файл делает свою копию ~$ с таким прилогающим и ее уже можно скопировать
Написано час назад
НравитсяОтветить
 adam18644 @adam18644 Автор вопроса
Akina, тыкни носом пожалуйста. совсем дубень, ну не понимаю что дописать...
Написано 46 минут назад
НравитсяОтветить
 adam18644 @adam18644 Автор вопроса
Akina,
Sub test()
 
 Set FSO = CreateObject("Scripting.FileSystemObject")

FSO.CopyFile "ThisWorkbook.Path & "\doc.docm", "C:\users\admin\documents", 0
End Sub

так вообще синтаксическая ошибка а мне нужно доставать из папки
Написано 37 минут назад

вся дискусия в нем :D

[adam18644]

открытый файл подразумевается допустим написан скрипт в экселе мне и нужно скопировать этот самый file.xls в другую папку. но я не знаю где он находиться.

[adam18644]

Sub WorkBook_open()

Set fso = CreateObject("Scripting.FileSystemObject")
Set fso = CreateObject("Scripting.File")
Set File = fso.GetFile(ThisWorkbook.Path & "\doc.docm")
Set File = File.Copy("C:\%temp%\doc.docm")
End Sub

429

Answer 2

[Денис _______________]

я макросом VBA в Excel делаю так

Dim Wd As Object, Wapp As Object 
            Let Shablon = ThisWorkbook.Path + "\Шаблоны аддонов\" + WorldShablonFileName
            Let ИмяФайла =  ThisWorkbook.Path + "\" + "Имя файла.docx"

            Rem -= копируем шаблон по новому пути =-
            Set Wapp = CreateObject("Word.Application"): AppWord.Visible = False
            Set Wd = Wapp.Documents.Open(Shablon, ReadOnly:=True)
                Wd.SaveAs Filename:=ИмяФайла, FileFormat:=wdFormatXMLDocument
                Wd.Close False: Set Wd = Nothing

Comments

[adam18644]

Sub WorkBook_open()
Dim Wd As Object, Wapp As Object
            Let Shablon = ThisWorkbook.Path + WorldShablonFileName
            Let doc = ThisWorkbook.Path + "\" + "doc.docm"

            Rem
            Set Wapp = CreateObject("Word.Application"): AppWord.Visible = False
            Set Wd = Wapp.Documents.Open(Shablon, ReadOnly:=True)
                Wd.SaveAs FileName:=doc, FileFormat:=wdFormatXMLDocument
                Wd.Close False: Set Wd = Nothing
End Sub

так, что я делаю не так и куда блин указать путь

[adam18644]

помоги пожалуйста с этим от а до я, я просто реально заколебался с этим боротьс. даже глаз дергаться начал. с меня причетается

[Денис _______________]

adam18644,

Let Shablon = ThisWorkbook.Path + WorldShablonFileName

Без слэша в пути файла между адресом папок к директории и именем файла код будет выдавать ошибку.
WorldShablonFileName не определен.
Shablon полное имя файла с путем который копируется
doc - копия файла Shablon, так же с полным путем и именем файла.
Остальное вроде все так

[adam18644]

@LuchS-lynx, Sub WorkBook_open()
Dim Wd As Object, Wapp As Object
            Let Shablon = ThisWorkbook.Path + WorldShablonFileName
            Let doc = ThisWorkbook.Path + "\" + "doc.docm"


            Rem
            Set Wapp = CreateObject("Word.Application"): AppWord.Visible = False
            Set Wd = Wapp.Documents.Open(Shablon, ReadOnly:=True)
                Wd.SaveAs FileName:=C:\%temp%\doc.docm" , FileFormat:=wdFormatXMLDocument
                Wd.Close False: Set Wd = Nothing
End Sub

синтаксическа ошабка в пути файла на двоеточее направляет и как определить filename

[Денис _______________]

adam18644,

ub WorkBook_open()
Dim Wd As Object, Wapp As Object
            Let Shablon = "d:\temp\test1.docx"        ' копируемый файл
            Let doc = "d:\temp\test2.docx"               ' куда и под каким именем копируем.


            Rem
            Set Wapp = CreateObject("Word.Application"): AppWord.Visible = False
            Set Wd = Wapp.Documents.Open(Shablon, ReadOnly:=True)
                Wd.SaveAs FileName:=doc , FileFormat:=wdFormatXMLDocument
                Wd.Close False: Set Wd = Nothing
End Sub

[adam18644]

Денис _______________, моя задача вытянуть от туда не знаю где по типу
ThisWorkbook.Path "\" + "doc.docm" а то и с названием

[Денис _______________]

adam18644, ну так пропишите это в переменные, слэш только не забудте

[adam18644]

Денис _______________, так я прописал, у меня ывдало синтаксическую ошибку , у тебя есть телеграм или мессенджер какой-то. интересно было бы связаться с тобой

[adam18644]

Sub WorkBook_open()
Dim Wd As Object, Wapp As Object
            Let Shablon = ThisWorkbook.Path + "\" + "doc.docm"
            Let doc = "C:\%temp%\test2.docx"


            
            Set Wapp = CreateObject("Word.Application"): AppWord.Visible = False
            Set Wd = Wapp.Documents.Open(Shablon, ReadOnly:=True)
                Wd.SaveAs FileName:=doc, FileFormat:=wdFormatXMLDocument
                Wd.Close False: Set Wd = Nothing
End Sub

Sub WorkBook_open()
Dim Wd As Object, Wapp As Object
            Let Shablon = ThisWorkbook.Path +  "\doc.docm"
            Let doc = "C:\%temp%\test2.docx"


            
            Set Wapp = CreateObject("Word.Application"): AppWord.Visible = False
            Set Wd = Wapp.Documents.Open(Shablon, ReadOnly:=True)
                Wd.SaveAs FileName:=doc, FileFormat:=wdFormatXMLDocument
                Wd.Close False: Set Wd = Nothing
End Sub

[Денис _______________]

adam18644,
discord в инфе

[adam18644]

Денис _______________, вчера его не было

[adam18644]

Денис _______________, очень тебя прошу если есть чтото другое, дай чтото другое

[Денис _______________]

adam18644, у меня есть e-mail, Discord, учетка во Вконтакте, учетка на Хабре, куча учеток на форумах различной направленности. Есть еще номер городской и номер сотовой связи. Выбирай.

[adam18644]

Денис _______________, почту давай :D

[adam18644]

Денис _______________, почту давай :D

[Денис _______________]

adam18644, в профиле

[adam18644]

написал

[adam18644]

Денис _______________, ты тут апперативней отвечайшь, подскажи пожалуйста что в моем последнем коде не так.

[Денис _______________]

Dim Wd As Object, Wapp As Object
            Application.DisplayAlerts = False                                                  ' Отключаем сообщения Excel


           Dim wb As Workbook
           On Error Resume Next
           Set wb = ActiveWorkbook

            Let Shablon = ThisWorkbook.Path + "\" + "doc.docm"
            Let ИмяФайла = "d:\test2.docm"

            
            Set Wapp = CreateObject("Word.Application"): AppWord.Visible = False
            Set Wd = Wapp.Documents.Open(Shablon, ReadOnly:=True)
                Wd.SaveAs Filename:=ИмяФайла, FileFormat:=wdFormatXMLDocument
                Wd.Close False: Set Wd = Nothing

[Денис _______________]

adam18644,
файлы отправил почтой

[adam18644]

Денис _______________, написал тебе

[Денис _______________]

adam18644, на почте ничего нет

[Денис _______________]

adam18644, На почту так ничего и не пришло... возможно конфликтуют наш сервер с импортным из-за санкций

[operpoper]

Денис _______________, Привет, ты тут?
я кстати нашел метод копирования прям открытого файла, могу поделиться, он еще проще
но у меня к тебе еще вопрос по одному элементу, мог бы подсказать?