Создание Bat-файла с данными Excel с помощью VBA

Я взял некоторые исследования от google

Sub ExportRangetoFile()

    Dim wb As Workbook
    Dim saveFile As String
    Dim WorkRng As Range
    Set WorkRng = Sheets("Match").Range("K:K")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wb = Application.Workbooks.Add
    WorkRng.Copy
    wb.Worksheets(1).Paste
    wb.SaveAs Filename:="C:UsersxxxxDesktopnewcurl.bat", FileFormat:= _
    xlTextPrinter, CreateBackup:=False
    wb.Close
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

но результат отображается в формате bat был негабаритных. Поскольку каждая ячейка в этом столбце содержит 295 символов (строка).

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

любые идеи или обойти?

пример.

в одной ячейке (excel)

curl abcd....ef

curl ghij....kl

in .летучая мышь

curl abcd....

curl ghij....

ef

kl

17
задан D.chan
19.05.2023 21:54 Количество просмотров материала 3368
Распечатать страницу

1 ответ

Я принял ваш вопрос к виду:

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


попробуйте следующий VBA, очевидно, указав свой собственный путь вывода:

Sub ExportRangetoFile()

    Dim ColumnNum: ColumnNum = 11   ' Column K
    Dim RowNum: RowNum = 1          ' Row to start on
    Dim objFSO, objFile

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile("C:\Users\Jonno\Documents\test\newcurl.bat")    'Output Path

    Dim OutputString: OutputString = ""

    Do
        OutputString = OutputString & Replace(Cells(RowNum, ColumnNum).Value, Chr(10), vbNewLine) & vbNewLine
        RowNum = RowNum + 1
    Loop Until IsEmpty(Cells(RowNum, ColumnNum))

    objFile.Write (OutputString)

    Set objFile = Nothing
    Set objFSO = Nothing

End Sub

или если ваш лист содержит пустые строки:

Sub ExportRangetoFile()

    Dim ColumnNum: ColumnNum = 11   ' Column K
    Dim RowNum: RowNum = 0
    Dim objFSO, objFile

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.CreateTextFile("C:\Users\Jonno\Documents\test\newcurl.bat")    'Output Path

    Dim OutputString: OutputString = ""

    Dim LastRow: LastRow = Application.ActiveSheet.Cells(Application.ActiveSheet.Rows.Count, ColumnNum).End(xlUp).Row

    Do
nextloop:
        RowNum = RowNum + 1
        If (IsEmpty(Cells(RowNum, ColumnNum).Value)) Then
            GoTo nextloop:
        End If
        OutputString = OutputString & Replace(Cells(RowNum, ColumnNum).Value, Chr(10), vbNewLine) & vbNewLine


    Loop Until RowNum = LastRow

    objFile.Write (OutputString)

    Set objFile = Nothing
    Set objFSO = Nothing

End Sub
1
отвечен Jonno 2023-05-21 05:42

Постоянная ссылка на данную страницу: [ Скопировать ссылку | Сгенерировать QR-код ]

Ваш ответ

Опубликуйте как Гость или авторизуйтесь

Имя
Вверх