Формирование CSV из экселя

' Выгрузка в .CSV
Sub Export()
Dim l_sheet As String
Dim l_rowval As String
Dim l_file As String
Dim l_out As Object
Dim l_fout As Variant
Dim l_tmp

Dim l_regex As New RegExp
Dim l_matches

l_regex.Pattern = "\(([\S]+)\)"
With l_regex
.Global = True
.IgnoreCase = True
End With

l_sheet = "Test"
If l_regex.Test(ActiveSheet.Name) Then
Set matches = l_regex.Execute(ActiveSheet.Name)
l_sheet = matches(0).SubMatches(0)
'Else
' MsgBox "Specify filename in parentheses (e.g. ""Listname (FILE_NAME)"")"
End If

'l_file = InputBox("Введите имя файла", "Сохранить лист", l_sheet & ".CSV")
l_file = UCase(l_sheet)

l_fout = Application.GetSaveAsFilename( _
FileFilter:="Файл с разделителем ; (*.csv), *.csv", _
InitialFileName:=l_file, _
Title:="Сохранить содержимое в файл" _
)

If l_fout = False Then
l_tmp = MsgBox(Prompt:="Отменено пользователем", _
Buttons:=vbInformation Or vbOKOnly, _
Title:="Не сохранено" _
)
Exit Sub
End If

Set l_out = CreateObject("ADODB.Stream")
l_out.Charset = "utf-8"
l_out.Open
'Open l_file For Output As #1


For l_rnum = 6 To ActiveSheet.UsedRange.Rows.Count
l_rowval = ""
For l_cnum = 1 To ActiveSheet.UsedRange.Rows(6).Columns.End(xlToRight).Column
l_rowval = l_rowval & Cells(l_rnum, l_cnum).Value & ";"
Next l_cnum
l_rowval = l_rowval & vbCrLf
'Print #1, l_rowval
l_out.Writetext l_rowval
Next l_rnum

l_out.SaveToFile l_fout, 2
'Close #1

MsgBox "Лист сохранен в файл " & l_fout

End Sub
' Преобразует в текст
Sub Format_Data_As_Text()
Dim l_val As String
Dim l_cell As Object


For Each l_cell In Selection.SpecialCells(xlCellTypeVisible)
l_val = l_cell.Value
l_cell.Value = l_val
Next l_cell

End Sub
' Добавляем слева нули до определнной длины
Sub Selection_Lpad_Zeroes()
Dim l_val As String
Dim l_regex As New RegExp
Dim l_len As Integer
Dim l_cell As Object

l_regex.Pattern = "^[0-9]+$"
With l_regex
.Global = True
.IgnoreCase = True
End With

l_len = InputBox("Длина поля для дополнения нулями", "Дополнить нулями до длины...", 4)
For Each l_cell In Selection.SpecialCells(xlCellTypeVisible)
l_val = l_cell.Value
If l_regex.Test(l_val) Then
l_val = Right(String(l_len, "0") & l_val, l_len)
l_cell.Value = l_val
End If
Next l_cell

End Sub
' Преобразует все кавычки к одному типу ""
Sub Format_Quotes()
Dim l_regex As New RegExp
Dim l_val As String
Dim l_cell As Object

l_regex.Pattern = "«|»"
With l_regex
.Global = True
.IgnoreCase = True
End With

For Each l_cell In Selection.SpecialCells(xlCellTypeVisible)
l_val = l_cell
If l_regex.Test(l_val) Then
l_val = l_regex.Replace(l_val, """")
l_cell.Value = l_val
End If
Next l_cell

End Sub

Sub ZF()
Dim l_regex As New RegExp
Dim l_val As String
Dim l_cell As Object

l_regex.Pattern = "«|»"
With l_regex
.Global = True
.IgnoreCase = True
End With

For Each l_cell In Selection.SpecialCells(xlCellTypeVisible)
l_cell.Value = "ЗФ"
Next l_cell

End Sub

' Удаляем пробелы
Sub Trim()
Dim l_regex As New RegExp
Dim l_val As String
Dim l_cell As Object

l_regex.Pattern = "^ +| +$"
With l_regex
.Global = True
.IgnoreCase = True
End With

For Each l_cell In Selection.SpecialCells(xlCellTypeVisible)
l_val = l_cell
If l_regex.Test(l_val) Then
l_val = l_regex.Replace(l_val, "")
l_cell.Value = l_val
End If
Next l_cell
End Sub