Здравствуйте! Возникла такая проблема. Есть макрос на сохранение данных из одного листа файла. И если файл уже существует, то выходит соответствующие предупреждение. Но при первом запуске макроса создается пустой файл (т.е. данные из листа не копируются), а при повторном сохранении файл создается с данными. С чем это связано? Вот код:
[vba]
Код
On Error Resume Next Set FSO = CreateObject("scripting.filesystemobject") ' создаём главную папку BaseFolder$ = "C:\Sewage\": MkDir BaseFolder$ MkDir BaseFolder$ ' создаём подпапку BaseFolder$ = "C:\Sewage\line" & Range("B1").Value & "\": MkDir BaseFolder$ MkDir BaseFolder$
' проверка на существование файла If Dir(BaseFolder$ & "line" & Range("B1").Value & ".collectin") > "" Then
Dim iRet As Integer Dim strPrompt As String Dim strTitle As String
' Promt strPrompt = "Файл уже существует! Перезаписать?"
' Check pressed button If iRet = vbNo Then MsgBox "Сохранение отменено!" Else MsgBox "Файл перезаписан!" ' создаём текстовый файл в кодировке Unicode Set ts = FSO.CreateTextFile(BaseFolder$ & "line" & Range("B1").Value & ".collectin", True) ts.Close ' заполняем его данными Open "C:\Sewage\line" & Range("B1").Value & "\" & "line" & Range("B1").Value & ".collectin" For Output As #1 Range("1:1048576").Copy With New DataObject .GetFromClipboard Print #1, Replace(.GetText(1), vbTab, "|") End With Application.CutCopyMode = False Close #1 MsgBox "Файл создан и помещен в папку" & vbNewLine & BaseFolder$, vbInformation, "Готово" ' открываем папку с файлом CreateObject("wscript.shell").Run "explorer.exe /e, """ & BaseFolder$ & """" End If
Else ' создаём текстовый файл в кодировке Unicode Set ts = FSO.CreateTextFile(BaseFolder$ & "line" & Range("B1").Value & ".collectin", True) ts.Close ' заполняем его данными Open "C:\Sewage\line" & Range("B1").Value & "\" & "line" & Range("B1").Value & ".collectin" For Output As #1 Range("1:1048576").Copy With New DataObject .GetFromClipboard Print #1, Replace(.GetText(1), vbTab, "|") End With Application.CutCopyMode = False Close #1 MsgBox "Файл создан и помещен в папку" & vbNewLine & BaseFolder$, vbInformation, "Готово" ' открываем папку с файлом CreateObject("wscript.shell").Run "explorer.exe /e, """ & BaseFolder$ & """" End If
[/vba]
Здравствуйте! Возникла такая проблема. Есть макрос на сохранение данных из одного листа файла. И если файл уже существует, то выходит соответствующие предупреждение. Но при первом запуске макроса создается пустой файл (т.е. данные из листа не копируются), а при повторном сохранении файл создается с данными. С чем это связано? Вот код:
[vba]
Код
On Error Resume Next Set FSO = CreateObject("scripting.filesystemobject") ' создаём главную папку BaseFolder$ = "C:\Sewage\": MkDir BaseFolder$ MkDir BaseFolder$ ' создаём подпапку BaseFolder$ = "C:\Sewage\line" & Range("B1").Value & "\": MkDir BaseFolder$ MkDir BaseFolder$
' проверка на существование файла If Dir(BaseFolder$ & "line" & Range("B1").Value & ".collectin") > "" Then
Dim iRet As Integer Dim strPrompt As String Dim strTitle As String
' Promt strPrompt = "Файл уже существует! Перезаписать?"
' Check pressed button If iRet = vbNo Then MsgBox "Сохранение отменено!" Else MsgBox "Файл перезаписан!" ' создаём текстовый файл в кодировке Unicode Set ts = FSO.CreateTextFile(BaseFolder$ & "line" & Range("B1").Value & ".collectin", True) ts.Close ' заполняем его данными Open "C:\Sewage\line" & Range("B1").Value & "\" & "line" & Range("B1").Value & ".collectin" For Output As #1 Range("1:1048576").Copy With New DataObject .GetFromClipboard Print #1, Replace(.GetText(1), vbTab, "|") End With Application.CutCopyMode = False Close #1 MsgBox "Файл создан и помещен в папку" & vbNewLine & BaseFolder$, vbInformation, "Готово" ' открываем папку с файлом CreateObject("wscript.shell").Run "explorer.exe /e, """ & BaseFolder$ & """" End If
Else ' создаём текстовый файл в кодировке Unicode Set ts = FSO.CreateTextFile(BaseFolder$ & "line" & Range("B1").Value & ".collectin", True) ts.Close ' заполняем его данными Open "C:\Sewage\line" & Range("B1").Value & "\" & "line" & Range("B1").Value & ".collectin" For Output As #1 Range("1:1048576").Copy With New DataObject .GetFromClipboard Print #1, Replace(.GetText(1), vbTab, "|") End With Application.CutCopyMode = False Close #1 MsgBox "Файл создан и помещен в папку" & vbNewLine & BaseFolder$, vbInformation, "Готово" ' открываем папку с файлом CreateObject("wscript.shell").Run "explorer.exe /e, """ & BaseFolder$ & """" End If
Вот пример выложил. В нем всё работает нормально. У меня он в одном файле используется. который очень много весит. Там сохранение работает через раз. С чем это может быть связано?:)
Вот пример выложил. В нем всё работает нормально. У меня он в одном файле используется. который очень много весит. Там сохранение работает через раз. С чем это может быть связано?:)udarock