Создание файла CSV, как Unicodetext, Endig. CSV.VBA не может открывать, сохранять и закрывать изменения - PullRequest
3 голосов
/ 24 сентября 2019

Это мой первый вопрос здесь.Я всегда нахожу ответ на Google.Но теперь я потерялся.
Я пытался создать файл CSV.Все было хорошо, но потом я нашел несколько кириллических букв в моем экспорте.Эту проблему я решил с помощью следующего кода:

Set shtToExport = ThisWorkbook.Worksheets("Text")  'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False                  'Possibly overwrite without asking
wbkExport.SaveAs Filename:="C:\Users\" & Environ("username") & "\Desktop\AP Import.csv", FileFormat:=xlUnicodeText 

Сохранить файл как текст Unicode.Это решило мою проблему с кириллицей, и вопросительные знаки исчезли.
Я был счастлив, пока не попытался загрузить этот файл.Ничего не произошло.
Затем я открыл файл CSV, и после закрытия Excel попросил меня сохранить, поэтому я сделал это, а затем окно MSG " Некоторые функции в вашей книге могут быть потеряны, если вы сохраните его как Unicode" Я нажал «да» и снова попытался загрузить файл.И это сработало отлично.
Но я не могу закрыть и сохранить с вышеупомянутым msgbox в коде.Я пытался:

workbooks(AP Import.csv).save 
Workbooks(AP Import.csv).close SaveChanges = True

Что я хочу, это открыть AP import.csv, сохранить, нажмите да в msgbox "...... вы сохраните его как текст Unicode", но я не могу это сделатьс макросом.Мне удалось получить «Хотите сохранить ваши изменения в ...», но не в поле «Unicode msg».Я использую Excel 2013

Вот весь код:

Sub Test()
    '
    ' Test Macro

    Application.ScreenUpdating = False

    If IsEmpty(ThisWorkbook.Sheets("data").Range("A1")) Then
        MsgBox ("Vlož data z WebGate exportu")
        Exit Sub
    End If

    Dim wbkExport As Workbook
    Dim shtToExport As Worksheet

    Columns("S:W").Select
    Selection.Copy
    Sheets("Temp").Select
    Range("A1").Select
    ActiveSheet.Paste

    Range("F1").Select
    Sheets("data").Select
    Columns("E:E").Select
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("E:E,I:I").Select
    Range("I1").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp").Select
    Range("F1").Select
    ActiveSheet.Paste
    Range("H1").Select
    Sheets("data").Select
    Columns("L:O").Select

    Range("L:O,X:X,Z:Z").Select
    Range("Z1").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp").Select
    Range("H1").Select
    ActiveSheet.Paste
    Range("A2").Select

    ActiveWindow.SmallScroll Down:=357
    Range("A2:G800").Select

    Application.CutCopyMode = False
    Selection.Copy
    Sheets("To update").Select
    Range("A2").Select
    ActiveSheet.Paste
    Range("H2").Select
    Sheets("Temp").Select
    Range("N2").Select

    ActiveWindow.SmallScroll Down:=354
    Range("N2:Q800").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("To update").Select
    Range("H2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select

    Set shtToExport = ThisWorkbook.Worksheets("Text")  'Sheet to export as CSV
    Set wbkExport = Application.Workbooks.Add
    shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
    Application.DisplayAlerts = False                  'Possibly overwrite without asking
    wbkExport.SaveAs Filename:="C:\Users\" & Environ("username") & "\Desktop\AP Import.csv", FileFormat:=xlUnicodeText ' " & Date & "

    Application.DisplayAlerts = True

    ThisWorkbook.Close savechanges:=False
End Sub

1 Ответ

0 голосов
/ 24 сентября 2019

Просто добавьте после сохранения:

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