Автоматическое сохранение файла и данных

[snupy86]

Всем добрый день!!! Очень нужна Ваша помощь!

Ситуация следующая: из erp системы выгружается отчет в Excel, при выгрузке срабатывает макрос, смысл которого конвертация данных в utf-8. Все хорошо работает, сохранение файла проходит функцией Application.GetSaveAsFilename.

(fic = Application.GetSaveAsFilename("C:\log\" + Name, "CSV Files (*.csv), *.csv"))

Сейчас понадобилась возможность автоматического сохранения (без диалогового окна). Т.е. выгружаем отчет, файл сохраняется в определенной папке без вопроса сохранить как. Подскажите, пожалуйста, как реализовать?

Пробовал через функцию Workbooks.Add.SaveAs - файл сохраняется, но пустой, как будто создается новый файл.

(Workbooks.Add.SaveAs Filename:="C:\log\" + Name, FileFormat:=xlNormal)


Полный код:

ub traitement_lignes()
Dim derlig, dercol, fin, ligne As Integer
Dim cellule As Range
Dim info As String
Dim fic, tempo As String
' Nom_Fichier vgv

ToDay = Format(Date)
Name = "NAVISION_" + ActiveSheet.Range("B2") + "_" + ToDay + ".csv"

fic = Application.GetSaveAsFilename("C:\log\" + Name, "CSV Files (*.csv), *.csv")

If fic = False Then Exit Sub

derlig = ActiveSheet.Range("a65536").End(xlUp).Row
dercol = ActiveSheet.Range("a1").End(xlToRight).Column
inistream

For ligne = 1 To derlig
    info = ""
    For Each cellule In Range(Cells(ligne, 1), Cells(ligne, dercol))
        info = info & cellule.Value & ";"
    Next
    If ligne = derlig Then fin = 1 Else fin = 0
    info = ConvertStringToUtf8Bytes(Left(info, Len(info) - 1) & vbCrLf, fin, fic)
Next

End Sub

Выкладываю исходный excel шаблон, там по кнопке Export to csv можно посмотреть как работает данный код.

Спасибо!

[gling]

Workbooks.Add.SaveAs

А просто  ActiveWorkbook.Save не пробовали?

[RAN]

Код Выделить Развернуть

Sub op()
    Dim arr, i&, j&, strc, strc1$
    arr = ActiveSheet.Range("A1").CurrentRegion.Value
    ReDim strc(1 To UBound(arr))
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            strc(i) = strc(i) & ";" & arr(i, j)
        Next
        strc(i) = Right$(strc(i), Len(strc(i)) - 1)
    Next
    strc1 = Join(strc, vbNewLine)
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Mode = 3
        .Charset = "utf-8"
        .Open
        .WriteText strc1
        .SaveToFile "C:\log\КАК ПОНДРВИТСЯ.csv", 2
        .Close
    End With
End Sub

[snupy86]

Workbooks.Add.SaveAs

А просто  ActiveWorkbook.Save не пробовали?

Пробовал, не получилось. Спасибо за совет.

[snupy86]

Код Выделить Развернуть

Sub op()
    Dim arr, i&, j&, strc, strc1$
    arr = ActiveSheet.Range("A1").CurrentRegion.Value
    ReDim strc(1 To UBound(arr))
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            strc(i) = strc(i) & ";" & arr(i, j)
        Next
        strc(i) = Right$(strc(i), Len(strc(i)) - 1)
    Next
    strc1 = Join(strc, vbNewLine)
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Mode = 3
        .Charset = "utf-8"
        .Open
        .WriteText strc1
        .SaveToFile "C:\log\КАК ПОНДРВИТСЯ.csv", 2
        .Close
    End With
End Sub

Спасибо за совет, все получилось!!!