импорт TXT в XLS(расчет по формулам)-экспорт в XML

[mchip]

Вот еще вариант.

[Zhiltsov]

Попробую прикрутить к своим данным.
Спасибо большое.

[Zhiltsov]

Sub ExporXML()
Application.DisplayAlerts = False: Application.ScreenUpdating = False
'MsgBox "Макрос экспорта временно отсутсвует"
Dim Filename As Variant
Dim Rng As Range
Dim r As Long, c As Long

Set Rng = Range("XML_spisok")


For r = 3 To Rng.Rows.Count

'Пока диалог но можно сделать без всяких вопросов

Filename = Application.GetSaveAsFilename(Initi alFileName:="c:\xml\xadvapl" & Rng(r, 3) & "_" & Right(CStr(100000 + Rng(r, 6)), 5), _
fileFilter:="XML Files (*.xml), *.xml")

If Filename = False Then Exit Sub

Open Filename For Output As #1
___________________________________
Как сделать чтобы файлы сохранялись не в папку по умолчанию,а например в C:\XMLOW, причем если данная папка отсутствует то она автоматически создавалась и при этом без запроса о сохранении?

[EducatedFool]

Первой строкой в макросе ставим

On Error Resume Next: MkDir "C:\XMLOW"

И заменяем

Filename = Application.GetSaveAsFilename( _
                   InitialFileName:="c:\xml\xadvapl" & Rng(r, 3) & "_" & Right(CStr(100000 + Rng(r, 6)), 5), _
                   fileFilter:="XML Files (*.xml), *.xml")

        If Filename = False Then Exit Sub

на

Filename = "C:\XMLOW\xadvapl" & Rng(r, 3) & "_" & Right(CStr(100000 + Rng(r, 6)), 5)

PS: И за одним уж можете заменить загадочный код Right(CStr(100000 + Rng(r, 6))
на что-нибудь вроде этого: Format(Rng(r, 6), "00000")

[Zhiltsov]

Не получается, файл должен сохраняться в XML формате.

[EducatedFool]

Ну тогда не

Filename = "C:\XMLOW\xadvapl" & Rng(r, 3) & "_" & Right(CStr(100000 + Rng(r, 6)), 5)

а

Filename = "C:\XMLOW\xadvapl" & Rng(r, 3) & "_" & Right(CStr(100000 + Rng(r, 6)), 5) & ".xml"

[Zhiltsov]

Отлично! Все работает! А можно добавить диалог, чтобы перед записью в каталог XMLOW файлов он проверял есть ли там файлы или нет и если есть предлагал бы очистить папку ("ДА" "НЕТ")

[EducatedFool]

Sub test()
    Folder = "C:\XMLOW\": Mask = "*.*": Filename = Dir(Folder & Mask)
    msg = "Удалить все файлы из папки " & Folder & " перед продолжением?"

    If Len(Filename) Then
        If MsgBox(msg, vbQuestion + vbYesNo, "Что делать?") = vbYes Then
            While Filename <> ""
                Kill Folder & Filename: Filename = Dir
            Wend
        End If
    End If
End Sub

[Zhiltsov]

Все работает. Спасибо!

[Zhiltsov]

Сообщение от EducatedFool

Ну тогда не

Filename = "C:\XMLOW\xadvapl" & Rng(r, 3) & "_" & Right(CStr(100000 + Rng(r, 6)), 5)

а

Filename = "C:\XMLOW\xadvapl" & Rng(r, 3) & "_" & Right(CStr(100000 + Rng(r, 6)), 5) & ".xml"

Тут начали тестировать эти файлы, оказывается файлы должны быть в XML формате но при этом иметь расширение равное номеру дня с начала года (юлианская дата)
Это можно как нибудь реализовать?