Макрос сохранения XML файла без диалогового окна

Пользователь

Сообщений: 43 Регистрация: 05.06.2014

14.03.2019 18:15:08

доброго времени суток
есть 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

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

Anton2201

Пользователь

Сообщений: 2 Регистрация: 15.03.2019

15.03.2019 01:56:43

Код
With CreateObject("scripting.filesystemobject") With .CreateTextFile(ThisWorkbook.Path & "\ThisWorkbook.Name.txt", True) .Write s: .Close End With

Андрей Лящук

Пользователь

Сообщений: 564 Регистрация: 18.02.2013

15.03.2019 02:55:00

Если сохранять нужно в текущей папке в файл с именем книги

Код

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.03.2019 03:00:27

assedo Пользователь Сообщений: 43 Регистрация: 05.06.2014	#4 15.03.2019 13:10:17 Андрей Лящук, благодарю работает