Невозможно сохранить файл .xlsx как .csv со специальными символами - PullRequest
0 голосов
/ 05 мая 2020
• 1000 Процесс работает, но файл csv изменил специальные символы. Я считаю, что это связано с кодировкой файла. Текущий процесс использует VBA для сохранения файла, а затем вызывает .vbs для его преобразования.

Я попытался принудительно сохранить окончательный файл csv в формате xlsUTF8, установив csv_format = 62, но это не удалось с этим как неожиданный аргумент.

Следующее, что я попробовал, - это сохранить файл как txt-файл, а затем преобразовать его в csv, но, похоже, это не решило проблему.

Процесс выполняется на машине с Excel 2016 установлены. У меня нет опыта написания сценариев, поэтому приведенный ниже код был позаимствован у коллег, и я уверен, что его можно значительно улучшить. Заранее приносим извинения за любые школьные ошибки.

VBA

Public Sub FileSave(itm As Outlook.MailItem)
    'Declare variables
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim archiveFolder As String
    Dim Filename As String
    Dim dateFormat As String

    dateFormat = Format(Now, "ddmmyyyy_hhnnss")
    saveFolder = "C:\File\"
    archiveFolder = "C:\File\Archive\"
    Filename = "Test.xlsx"

         For Each objAtt In itm.Attachments
                Dim fso
                Set fso = CreateObject("Scripting.FileSystemObject")
                'Check to see if file exists in saveFolder directory.
                'If it already exists then move to achiveFolder location and rename with time/date stamp.
                If fso.FileExists(saveFolder & Filename) Then
                    fso.CopyFile saveFolder & Filename, archiveFolder & Filename
                    fso.MoveFile archiveFolder & Filename, archiveFolder & dateFormat & "_OLD.xlsx"
                    objAtt.SaveAsFile saveFolder & Filename
                    Set objAtt = Nothing
                'If it does not exist then copy attachment to saveFolder directory.
                Else
                    objAtt.SaveAsFile saveFolder & Filename
                    Set objAtt = Nothing
                End If

         Next
    Shell "C:\Windows\System32\cscript.exe C:\File\Remove_trailing_lines.vbs", 1
End Sub

VBS 'Remove_Trailing_Lines.vbs'

Const ForReading = 1, ForWriting = 2
Const TristateUseDefault = -2, TristateUnicode = -1, TristateASCII = 0
Set objFSo = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile("C:\File\Test.xlsx", ForReading, false, TristateUseDefault)
strContents = objFile.ReadAll
objFile.Close

'Remove trailing lines from file
intLength = Len(strContents)
for i=intLength to 1 step -1
    if Mid(strContents,i,1)=Chr(10) or Mid(strContents,i,1)=Chr(13) then    
        strContents = Mid(strContents,1,Len(strContents)-1)
    else
        exit for
    end if
next

txt_format =42
csv_format =6
Dim objExcel
Dim objBook
Dim objBook_xls
Dim objSheet
Dim objWshShell

Set objExcel = CreateObject("Excel.Application")
Set objBook = objExcel.WorkBooks.Open("C:\File\Test.xlsx", ForWriting, True)
Set objSheet = objBook.Worksheets("Sheet1")
Set objWshShell = CreateObject("Wscript.Shell")

'Tidy up rows and column names
objExcel.DisplayAlerts = False
objBook.SaveAs "C:\File\Test.txt", txt_format
objBook.Close False

Set objBook_txt = objExcel.WorkBooks.Open("C:\File\Test.txt", ForWriting, True)

'Save to csv from txt
objBook_txt.SaveAs "C:\File\Test.csv", csv_format
objBook_txt.Close False
objExcel.DisplayAlerts = true
objExcel.Quit

WScript.Quit  

Если кто-нибудь может мне помочь с процессом, я очень благодарен.

Дэйв

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...