Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос сохранения XML файла без диалогового окна
 
доброго времени суток
есть excel файл из которого генерируется xml файл с помощью макроса, происходит это по нажатию кнопки с последующим предложением куда сохранить.
так как xml всегда имеет одно и тоже название и место хранения, как можно подправить макрос (ниже) чтобы xml файл перезаписывал старый без окна сохранения и сообщения о существовании такого файла
сам макрос:
Код
Private Sub CreateXML_Click()
    On Error GoTo EH_CreateXML_Click
    
 Dim name As String
    name = "WORK " & Worksheets("table").Range("Comp").Value & ".xml"
    
 
    fileToSave = Application.GetSaveAsFilename(name, "Dokumenty XML (*.xml), *.xml")
      
      
    If fileToSave <> False Then
        Dim xml As String
        xml = GenXML()
       
        Dim fso, MyFile
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set MyFile = fso.CreateTextFile(fileToSave, True, True)

        MyFile.Write xml
        MyFile.Close
    Else
        MsgBox "Not chosen", vbInformation
    End If
    Exit Sub
    
EH_CreateXML_Click:
    MsgBox Err.Description, vbCritical, "Error in " & "CreateXML_Click()"
End Sub

заранее благодарю

 
Код
With CreateObject("scripting.filesystemobject")
 With .CreateTextFile(ThisWorkbook.Path & "\ThisWorkbook.Name.txt", True)
 .Write s: .Close
 End With
 
Если сохранять нужно в текущей папке в файл с именем книги
Код
Private Sub CreateXML_Click()
    On Error GoTo EH_CreateXML_Click

    With ThisWorkbook
        fileToSave = Mid(.FullName, 1, InStrRev(.FullName, ".")) & "xml"
    End With
       
    If fileToSave <> False Then
        Dim xml As String
        xml = GenXML()
        
        Dim fso, MyFile
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set MyFile = fso.CreateTextFile(fileToSave, True, True)
 
        MyFile.Write xml
        MyFile.Close
    Else
        MsgBox "Not chosen", vbInformation
    End If
    Exit Sub
     
EH_CreateXML_Click:
    MsgBox Err.Description, vbCritical, "Error in " & "CreateXML_Click()"
End Sub
Изменено: Андрей Лящук - 15 Мар 2019 03:00:27
 
Андрей Лящук, благодарю работает
Страницы: 1
Читают тему (гостей: 1)
Наверх