Как сохранить текстовый файл (CSV) с UTF-8 без кодировки спецификации в VBA (Excel)? Сохранить как файл vba


Использование VBA, как сохранить файл в относительном каталоге MS Excel онлайн

У меня есть следующий код для сохранения содержимого книги Excel в виде файла с разделителями табуляции.

Sub maketxtfile(className As String, rosterFileHandle As String) Dim i As Long, gradebookContent As String With Worksheets(className).UsedRange For i = 1 To .Rows.Count gradebookContent = gradebookContent & vbCrLf & Join$(Application.Transpose(Application.Transpose(.Rows(i).Value)), vbTab) Next End With Open Replace(ThisWorkbook.FullName, "Fall_2013_2014.xlsm", rosterFileHandle) For Output As #1 Print #1, Mid$(gradebookContent, Len(vbCrLf) + 1) Close #1 End Sub

Проблема в том, что я не хочу, чтобы файл с разделителями табуляции находился в том же каталоге, что и файл xlsm . Я хотел бы, чтобы файл находился в подкаталоге. Я видел решения, опубликованные с использованием абсолютных имен путей. Это не вариант для меня, я не обязательно знаю, как будет указываться путь.

Я думал, что смогу сделать что-то вроде:

Open Replace(ThisWorkbook.FullName, "Fall_2013_2014.xlsm", "rosters/" & rosterFileHandle) For Output As #1 Print #1, Mid$(gradebookContent, Len(vbCrLf) + 1) Close #1

Но это привело меня к ошибке. Хотя я работаю на Mac, я пробовал использовать "rosters\" но в то время как это сработало, он не размещал мой файл в подкаталоге, а в файле с \\ в его имени пути.

Я был бы очень признателен за решение, которое покажет мне, как это сделать, используя относительные имена путей.

Кстати, я бы не прочь сначала создать файл с разделителями табуляции в текущем каталоге, а затем переместить его в подкаталог.

Solutions Collecting From Web of "Использование VBA, как сохранить файл в относительном каталоге"

Mac использует: как разделитель путей; это выглядит странно, если вы привыкли к DOS / Windows. Или, может быть, если вы являетесь пользователем dyslexic * nix ;-).

Если под «моими другими машинами» вы имеете в виду окна Windows, то нет, это не будет переносимым, поскольку двоеточие ограничено разграничением букв дисков в именах файлов. Лучше всего сделать что-то вроде этого:

Function PathSep() As String #If Mac Then PathSep = ":" #Else PathSep = "\" #End If End Function

Тогда вы могли бы:

Open Replace(ThisWorkbook.FullName, "Fall_2013_2014.xlsm", "." & PathSep & "rosters" & PathSep & rosterFileHandle) For Output As #1

После долгих поисков я нашел что-то, что работает.

Я могу написать:

Open Replace(ThisWorkbook.FullName, "Fall_2013_2014.xlsm", ".:rosters:" & rosterFileHandle) For Output As #1 Print #1, Mid$(gradebookContent, Len(vbCrLf) + 1) Close #1

Синтаксис кажется немного странным, используя «:», чтобы указать путь к каталогу, но он работает. Теперь вопрос в том, является ли это портативным и будет корректно работать на других моих машинах.

Это должно сделать трюк

ThisWorkbook.SaveAs (ThisWorkbook.Path & "\Rosters\" & ThisWorkbook.Name)

Редактировать:

Измененный код для сохранения текстового файла вместо этого также использовался chr (92) для передачи разделителя пути.

Sub maketxtfile() Dim i As Long, gradebookContent As String Dim rosterFileHandle As String rosterFileHandle = "tabtest.txt" rosterFileHandle = ThisWorkbook.Path & Chr(92) & "Rosters" & Chr(92) & rosterFileHandle With ActiveSheet.UsedRange For i = 1 To 10 gradebookContent = gradebookContent & vbCrLf & Join$(Application.Transpose(Application.Transpose(.Rows(i).Value)), vbTab) Next End With Open (rosterFileHandle) For Output As #1 Print #1, Mid$(gradebookContent, Len(vbCrLf) + 1) Close #1 End Sub

excel.bilee.com

Как сохранить сгенерированные выходные текстовые файлы в пользовательской выбранной папке в VBA?

Я создал код VBA, где я генерирую текстовые файлы. Я передаю 7 аргументов в под-метод для генерации всех текстовых файлов. Однако у меня возникают трудности с сохранением сгенерированных файлов в выбранной вами папке. Когда я запускаю код, он просто сохраняет все файлы в включенном пути (пока я не знаю, как сделать то, что я объясняю выше).

Ниже мой код, где я пытаюсь включить путь, который я могу использовать, чтобы любой пользователь мог выбрать папку для сохранения всех сгенерированных текстовых файлов.

Sub TextFiles() Dim fso As Scripting.FileSystemObject, Path As String 'Ask user to save files into a folder Path = "C:\Users\samplename\Desktop\TEST" 'Call sub procedure to generate text files and store them in NewFolderPath CreateTxtFiles.CreateTxtFiles Path & "\sample1.txt", 1, "sample1", "sample1_", 7, "sample1_2", 9 CreateTxtFiles.CreateTxtFiles Path & "\sample2.txt", 2, "sample2", "sample2_", 9, "0", 0 CreateTxtFiles.CreateTxtFiles Path & "\sample3.txt", 3, "sample3", "sample3", 5, "0", 0 CreateTxtFiles.CreateTxtFiles Path & "\sample4.txt", 4, "sample4", "sample4", 5, "0", 0

End Sub

Solutions Collecting From Web of "Как сохранить сгенерированные выходные текстовые файлы в пользовательской выбранной папке в VBA?"

Что-то вроде этого должно работать на вас:

Sub tgr() Dim ShellFolderPicker As Object Dim FolderPath As String Set ShellFolderPicker = CreateObject("Shell.Application") On Error Resume Next FolderPath = ShellFolderPicker.BrowseForFolder(0, "Select Folder to Save Files:", 0).Self.Path On Error GoTo 0 If Len(FolderPath) = 0 Then Exit Sub 'Pressed cancel CreateTxtFiles.CreateTxtFiles FolderPath & "\sample1.txt", 1, "sample1", "sample1_", 7, "sample1_2", 9 End Sub

Возможно, вы ищете FileDialog.SelectedItems Свойство https://msdn.microsoft.com/en-us/vba/office-shared-vba/articles/filedialog-selecteditems-property-office

Sub TextFiles() Dim MyFolder As FileDialog Dim Path As Variant Set MyFolder = Application.FileDialog(msoFileDialogFolderPicker) With MyFolder .AllowMultiSelect = False If .Show = -1 Then Path = .SelectedItems(1) Else End If End With 'Call sub procedure to generate text files and store them in NewFolderPath CreateTxtFiles.CreateTxtFiles Path & "\sample1.txt", 1, "sample1", "sample1_", 7, "sample1_2", 9 CreateTxtFiles.CreateTxtFiles Path & "\sample2.txt", 2, "sample2", "sample2_", 9, "0", 0 CreateTxtFiles.CreateTxtFiles Path & "\sample3.txt", 3, "sample3", "sample3", 5, "0", 0 CreateTxtFiles.CreateTxtFiles Path & "\sample4.txt", 4, "sample4", "sample4", 5, "0", 0

Надеюсь это поможет!

excel.bilee.com

vba - Как сохранить текстовый файл (CSV) с UTF-8 без кодировки спецификации в VBA (Excel)?

Так что это был мой первоначальный вопрос. Ответ на мой вопрос ниже, похоже, что единственным решением для получения кодировки UTF-8 (и UTF-8 без спецификации) является использование объекта ADODB.Stream. Ответ на мой новый вопрос в строке темы размещен как код.

Я сижу здесь и пытаюсь Save лист Excel как .CSV -file с макросом VBA. Тем не менее, мне интересно, имеет ли значение использование ADODB/ADODB.Stream или просто .SaveAs Fileformat:=xlCSV. Я попытался это сделать Google, и похоже, что я не могу найти ответ, какой метод является "лучшим". Для этого мне нужно было бы обозначить запятую, UTF-8 и двойные кавычки ("") в качестве текстового идентификатора.

Правильно ли, что, когда вы используете Fileformat:=, это невозможно для SaveAs UTF-8, поскольку xlCSV не использует эту кодировку? Да это верно.

Этот код преобразует ваш лист Excel и сохраняет его как файл CSV с UTF-8 без кодировки спецификации. Я нашел этот код на веб-сайте, поэтому не буду признавать его. CSV без ссылки BOM

Sub CSVFileAsUTF8WithoutBOM() Dim SrcRange As Range Dim CurrRow As Range Dim CurrCell As Range Dim CurrTextStr As String Dim ListSep As String Dim FName As Variant Dim UTFStream As Object Dim BinaryStream As Object ' ask for file name and path FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv") ' prepare UTF-8 stream Set UTFStream = CreateObject("adodb.stream") UTFStream.Type = adTypeText UTFStream.Mode = adModeReadWrite UTFStream.Charset = "UTF-8" UTFStream.LineSeparator = adLF UTFStream.Open 'set field separator ListSep = "," 'set source range with data for csv file If Selection.Cells.count > 1 Then Set SrcRange = Selection Else Set SrcRange = ActiveSheet.UsedRange End If For Each CurrRow In SrcRange.Rows 'enclose each value with quotation marks and escape quotation marks in values CurrTextStr = "" For Each CurrCell In CurrRow.Cells CurrTextStr = CurrTextStr & """" & Replace(CurrCell.Value, """", """""") & """" & ListSep Next 'remove ListSep after the last value in line While Right(CurrTextStr, 1) = ListSep CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1) Wend 'add line to UTFStream UTFStream.WriteText CurrTextStr, adWriteLine Next 'skip BOM UTFStream.Position = 3 'copy UTFStream to BinaryStream Set BinaryStream = CreateObject("adodb.stream") BinaryStream.Type = adTypeBinary BinaryStream.Mode = adModeReadWrite BinaryStream.Open 'Strips BOM (first 3 bytes) UTFStream.CopyTo BinaryStream UTFStream.Flush UTFStream.Close 'save to file BinaryStream.SaveToFile FName, adSaveCreateOverWrite BinaryStream.Flush BinaryStream.Close End Sub задан Niclas 06 апр. '15 в 11:50 источник поделиться

qaru.site