Макрос VBA, который создает три файла CSV - PullRequest
Новая
       8

Макрос VBA, который создает три файла CSV

0 голосов
/ 12 июня 2019

У меня есть следующий код VBA, который создает четыре файла .csv csv.sha512 csv.sha256 и .csv.gz на основе созданной мной таблицы excel.

Private Sub Export_Click()

Version = "1.0"
MyFileName = ActiveWorkbook.Name
MyFilePath = ActiveWorkbook.Path
MyFileName = Replace(MyFileName, ".xls", ".idl")
IdFiles = 1
fileName = MyFilePath & "\" & Cells(1, 3).Value & "_" & Format(Date, "yyyymmdd") & "_" & IdFiles & ".csv"

SelectionOnly = False
AppendData = False
delimeter = "|"
Application.ScreenUpdating = False
On Error GoTo EndMacro:


If SelectionOnly = True Then
    With Selection
        StartRow = 7
        StartCol = 2
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
Else
    With ActiveSheet.UsedRange
        StartRow = 7
        StartCol = 2
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
End If

CountRow = EndRow - StartRow + 1


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFSOBlokada = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(fileName) Then
    IsExistCSV = True


    Do While IsExistCSV = True
       fileName = MyFilePath & "\" & Cells(1, 3).Value & "_" & Format(Date, "yyyymmdd") & "_" & IdFiles & ".csv"

       If Not objFSO.FileExists(fileName) Then
          IsExistCSV = False
       End If
       IdFiles = IdFiles + 1 
    Loop
End If

Set objFile = objFSO.OpenTextFile(fileName, 2, True, -1)
objFile.Writeline Version & delimeter & CountRow

    For RowNdx = StartRow To EndRow
        WholeLine = ""
        For ColNdx = StartCol To EndCol

            If Cells(RowNdx, ColNdx).Value = "" Then
                CellValue = ""
            Else
               CellValue = Cells(RowNdx, ColNdx).Value
            End If


            If ColNdx = EndCol Then
                WholeLine = WholeLine & CellValue
            Else
                WholeLine = WholeLine & CellValue & delimeter
            End If
        Next ColNdx
        WholeLine = Left(WholeLine, Len(WholeLine) - Len(sep))
        objFile.Writeline WholeLine
    Next RowNdx

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True

objFile.Close



Set objFileBlokada = objFSOBlokada.OpenTextFile(fileName & ".blokada", 2, True, -1)
objFileBlokada.Close


Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 0

shellcmd1 = "cmd.exe /C certutil -hashfile """ & fileName & """ SHA512 | find /i /v ""sha512"" | find /i /v ""certutil"" > """ & fileName & ".sha512"""
wsh.Run shellcmd1, windowStyle, waitOnReturn


shacmd256 = "cmd.exe /C certutil -hashfile """ & fileName & """ SHA256 | find /i /v ""sha256"" | find /i /v ""certutil"" > """ & fileName & ".sha256"""


shellcmd2 = "cmd /C """"c:\Program Files\7-Zip\7z.exe"" a -w""" & MyFilePath & """ -tgzip """ & fileName & ".gz"" " & """" & fileName & """"""


End Sub

Однако созданные файлы с BOM и кодировкой UCS2, мне нужно иметь их с кодировкой utf-8 с LF в качестве конца строки, тогда как теперь у меня есть crlf в качестве конца строки.Как это исправить?

Кроме того, мне нужно иметь utf-8 без спецификации, что довольно сложно достичь.

Есть идеи, как к этому подойти?

...